GitLab

at 2017-11-15T21:06:19-08:00

Update to asdf 3.3.1

 ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-

-;;; This is ASDF 3.3.0: Another System Definition Facility.

+;;; This is ASDF 3.3.1: Another System Definition Facility.

 ;;;

 ;;; Feedback, bug reports, and patches are all welcome:

 ;;; please mail to <asdf-devel@common-lisp.net>.

    #:string-prefix-p #:string-enclosed-p #:string-suffix-p

    #:standard-case-symbol-name #:find-standard-case-symbol ;; symbols

    #:coerce-class ;; CLOS

-   #:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps

-   #:earlier-stamp #:stamps-earliest #:earliest-stamp

-   #:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f

+   #:timestamp< #:timestamps< #:timestamp*< #:timestamp<= ;; timestamps

+   #:earlier-timestamp #:timestamps-earliest #:earliest-timestamp

+   #:later-timestamp #:timestamps-latest #:latest-timestamp #:latest-timestamp-f

    #:list-to-hash-set #:ensure-gethash ;; hash-table

    #:ensure-function #:access-at #:access-at-count ;; functions

    #:call-function #:call-functions #:register-hook-function

                     (string (standard-case-symbol-name package-designator)))

                   error)))

-;;; stamps: a REAL or a boolean where T=-infinity, NIL=+infinity

+;;; timestamps: a REAL or a boolean where T=-infinity, NIL=+infinity

 (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)

-  (deftype stamp () '(or real boolean)))

+  (deftype timestamp () '(or real boolean)))

 (with-upgradability ()

-  (defun stamp< (x y)

+  (defun timestamp< (x y)

     (etypecase x

       ((eql t) (not (eql y t)))

       (real (etypecase y

               (real (< x y))

               (null t)))

       (null nil)))

-  (defun stamps< (list) (loop :for y :in list :for x = nil :then y :always (stamp< x y)))

-  (defun stamp*< (&rest list) (stamps< list))

-  (defun stamp<= (x y) (not (stamp< y x)))

-  (defun earlier-stamp (x y) (if (stamp< x y) x y))

-  (defun stamps-earliest (list) (reduce 'earlier-stamp list :initial-value nil))

-  (defun earliest-stamp (&rest list) (stamps-earliest list))

-  (defun later-stamp (x y) (if (stamp< x y) y x))

-  (defun stamps-latest (list) (reduce 'later-stamp list :initial-value t))

-  (defun latest-stamp (&rest list) (stamps-latest list))

-  (define-modify-macro latest-stamp-f (&rest stamps) latest-stamp))

+  (defun timestamps< (list) (loop :for y :in list :for x = nil :then y :always (timestamp< x y)))

+  (defun timestamp*< (&rest list) (timestamps< list))

+  (defun timestamp<= (x y) (not (timestamp< y x)))

+  (defun earlier-timestamp (x y) (if (timestamp< x y) x y))

+  (defun timestamps-earliest (list) (reduce 'earlier-timestamp list :initial-value nil))

+  (defun earliest-timestamp (&rest list) (timestamps-earliest list))

+  (defun later-timestamp (x y) (if (timestamp< x y) y x))

+  (defun timestamps-latest (list) (reduce 'later-timestamp list :initial-value t))

+  (defun latest-timestamp (&rest list) (timestamps-latest list))

+  (define-modify-macro latest-timestamp-f (&rest timestamps) latest-timestamp))

 ;;; Function designators

 (in-package :uiop/version)

 (with-upgradability ()

-  (defparameter *uiop-version* "3.3.0")

+  (defparameter *uiop-version* "3.3.1")

   (defun unparse-version (version-list)

     "From a parsed version (a list of natural numbers), compute the version string"

     "A portable abstraction of a low-level call to libc's system()."

     (declare (ignorable keys directory input if-input-does-not-exist output

                         if-output-exists error-output if-error-output-exists))

+    (when (member :stream (list input output error-output))

+      (parameter-error "~S: ~S is not allowed as synchronous I/O redirection argument"

+                       'run-program :stream))

     #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)

     (let (#+(or abcl ecl mkcl)

             (version (parse-version

          ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5.

          ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5

          ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67

-         (asdf-version "3.3.0")

+         (asdf-version "3.3.1")

          (existing-version (asdf-version)))

     (setf *asdf-version* asdf-version)

     (when (and existing-version (not (equal asdf-version existing-version)))

   (defmethod record-dependency ((plan sequential-plan) (o operation) (c component))

     (values)))

-(when-upgrading (:version "3.2.1")

+(when-upgrading (:version "3.3.0")

   (defmethod initialize-instance :after ((plan plan-traversal) &key &allow-other-keys)))

     "Return the earliest status later than both status1 and status2"

     (make-action-status

      :bits (logand (status-bits status1) (status-bits status2))

-     :stamp (latest-stamp (status-stamp status1) (status-stamp status2))

+     :stamp (latest-timestamp (status-stamp status1) (status-stamp status2))

      :level (min (status-level status1) (status-level status2))

      :index (or (status-index status1) (status-index status2))))

             (in-files (input-files o c))

             (in-stamps (mapcar #'get-file-stamp in-files))

             (missing-in (loop :for f :in in-files :for s :in in-stamps :unless s :collect f))

-            (latest-in (stamps-latest (cons dep-stamp in-stamps))))

+            (latest-in (timestamps-latest (cons dep-stamp in-stamps))))

        (when (and missing-in (not just-done)) (return (values nil nil))))

      (let* (;; collect timestamps from outputs, and exit early if any is missing

             (out-files (remove-if 'null (output-files o c)))

             (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files))

             (missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f))

-            (earliest-out (stamps-earliest out-stamps)))

+            (earliest-out (timestamps-earliest out-stamps)))

        (when (and missing-out (not just-done)) (return (values nil nil))))

      (let (;; Time stamps from the files at hand, and whether any is missing

            (all-present (not (or missing-in missing-out)))

            ;; Has any input changed since we last generated the files?

-           ;; Note that we use stamp<= instead of stamp< to play nice with generated files.

+           ;; Note that we use timestamp<= instead of timestamp< to play nice with generated files.

            ;; Any race condition is intrinsic to the limited timestamp resolution.

-           (up-to-date-p (stamp<= latest-in earliest-out))

+           (up-to-date-p (timestamp<= latest-in earliest-out))

            ;; If everything is up to date, the latest of inputs and outputs is our stamp

-           (done-stamp (stamps-latest (cons latest-in out-stamps))))

+           (done-stamp (timestamps-latest (cons latest-in out-stamps))))

        ;; Warn if some files are missing:

        ;; either our model is wrong or some other process is messing with our files.

        (when (and just-done (not all-present))

     (assert (equal (coerce-name s) (primary-system-name s)))

     (nest

      (if-let ((pathname (first (input-files o s)))))

+     (let ((readtable *readtable*) ;; save outer syntax tables. TODO: proper syntax-control

+           (print-pprint-dispatch *print-pprint-dispatch*)))

      (with-standard-io-syntax)

      (let ((*print-readably* nil)

            ;; Note that our backward-compatible *readtable* is

            ;; a global readtable that gets globally side-effected. Ouch.

            ;; Same for the *print-pprint-dispatch* table.

            ;; We should do something about that for ASDF3 if possible, or else ASDF4.

-           (*readtable* *readtable*)

-           (*print-pprint-dispatch* *print-pprint-dispatch*)

+           (*readtable* readtable) ;; restore inside syntax table

+           (*print-pprint-dispatch* print-pprint-dispatch)

            (*package* (find-package :asdf-user))

            (*default-pathname-defaults*

             ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings.

           (let ((o (make-operation 'define-op)))

             (multiple-value-bind (stamp done-p)

                 (compute-action-stamp plan o system)

-              (return (and (stamp<= stamp (component-operation-time o system))

+              (return (and (timestamp<= stamp (component-operation-time o system))

                            done-p)))))

       (system-out-of-date () nil)))

                               (pathname-equal

                                (physicalize-pathname pathname)

                                (physicalize-pathname previous-pathname))))

-                     (stamp<= stamp previous-time)

+                     (timestamp<= stamp previous-time)

                      ;; TODO: check that all dependencies are up-to-date.

                      ;; This necessitates traversing them without triggering

                      ;; the adding of nodes to the plan.

Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

1 changed file:

Changes: