Raymond Toy pushed to branch master at cmucl / cmucl

Commits: 42192ed3 by Raymond Toy at 2017-11-15T21:06:19-08:00 Update to asdf 3.3.1

- - - - -

1 changed file:

- src/contrib/asdf/asdf.lisp

Changes:

===================================== src/contrib/asdf/asdf.lisp ===================================== --- a/src/contrib/asdf/asdf.lisp +++ b/src/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ ;;; -*- 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. @@ -1030,9 +1030,9 @@ Return a string made of the parts not omitted or emitted by FROB." #: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 @@ -1380,11 +1380,11 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo (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 @@ -1392,16 +1392,16 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo (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 @@ -1669,7 +1669,7 @@ message, that takes the functionality as its first argument (that can be skipped (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" @@ -6753,6 +6753,9 @@ or whether it's already taken care of by the implementation's underlying run-pro "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 @@ -7503,7 +7506,7 @@ previously-loaded version of ASDF." ;; "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))) @@ -9801,7 +9804,7 @@ unless identically to toplevel" (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)))

@@ -9889,7 +9892,7 @@ or NIL if no the status is considered outside of a specific plan.")) "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))))

@@ -10042,22 +10045,22 @@ initialized with SEED." (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)) @@ -10686,14 +10689,16 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (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. @@ -10837,7 +10842,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (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)))

@@ -10864,7 +10869,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (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.

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/42192ed35af09e9df691ec4d47...

--- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/42192ed35af09e9df691ec4d47... You're receiving this email because of your account on gitlab.common-lisp.net.