From 6a89cbc0d5ce5b10c94ee0746721dd643778bdfe Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Fri, 21 May 2010 17:18:04 -0400 Subject: [PATCH] 1.728: Only merge with pathname-directory-pathname of the parent's pathname, and let said handle the NIL case silently. This fixes a failure at compiling usocket without otherwise breaking our test suite. Remove compilation notes under SBCL. Remove markdown in docstrings. --- asdf.lisp | 55 +++++++++++++++++++++++++++---------------------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 2e4bc307..ea6ddfc2 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -70,7 +70,7 @@ :test 'equalp :key 'car)) (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate - (subseq "VERSION:1.727" (1+ (length "VERSION")))) + (subseq "VERSION:1.728" (1+ (length "VERSION")))) (existing-asdf (find-package :asdf)) (vername '#:*asdf-version*) (versym (and existing-asdf @@ -456,11 +456,11 @@ discarded instead of recorded.")) (defgeneric traverse (operation component) (:documentation -"Generate and return a plan for performing `operation` on `component`. +"Generate and return a plan for performing OPERATION on COMPONENT. -The plan returned is a list of dotted-pairs. Each pair is the `cons` -of ASDF operation object and a `component` object. The pairs will be -processed in order by `operate`.")) +The plan returned is a list of dotted-pairs. Each pair is the CONS +of ASDF operation object and a COMPONENT object. The pairs will be +processed in order by OPERATE.")) ;;;; ------------------------------------------------------------------------- @@ -480,7 +480,8 @@ processed in order by `operate`.")) (defun pathname-directory-pathname (pathname) "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME, and NIL NAME, TYPE and VERSION components" - (make-pathname :name nil :type nil :version nil :defaults pathname)) + (when pathname + (make-pathname :name nil :type nil :version nil :defaults pathname))) (defun merge-pathnames* (specified &optional (defaults *default-pathname-defaults*)) "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that if the SPECIFIED pathname @@ -491,7 +492,7 @@ Also, if either argument is NIL, then the other argument is returned unmodified. (let* ((specified (pathname specified)) (defaults (pathname defaults)) (directory (pathname-directory specified)) - (directory (if (stringp directory) `(:absolute ,directory) directory)) + #-sbcl (directory (if (stringp directory) `(:absolute ,directory) directory)) (name (or (pathname-name specified) (pathname-name defaults))) (type (or (pathname-type specified) (pathname-type defaults))) (version (or (pathname-version specified) (pathname-version defaults)))) @@ -643,13 +644,13 @@ pathnames." (si:getenv x)) (defun directory-pathname-p (pathname) - "Does `pathname` represent a directory? + "Does PATHNAME represent a directory? A directory-pathname is a pathname _without_ a filename. The three -ways that the filename components can be missing are for it to be `nil`, -`:unspecific` or the empty string. +ways that the filename components can be missing are for it to be NIL, +:UNSPECIFIC or the empty string. -Note that this does _not_ check to see that `pathname` points to an +Note that this does _not_ check to see that PATHNAME points to an actually-existing directory." (flet ((check-one (x) (member x '(nil :unspecific "") :test 'equal))) @@ -733,10 +734,8 @@ actually-existing directory." (directory (pathname-directory p))) (when (typep p 'logical-pathname) (return p)) (ignore-errors (return (truename p))) - (when (stringp directory) - (return p)) - (when (not (eq :absolute (car directory))) - (return p)) + #-sbcl (when (stringp directory) (return p)) + (when (not (eq :absolute (car directory))) (return p)) (let ((sofar (ignore-errors (truename (pathname-root p))))) (unless sofar (return p)) (flet ((solution (directories) @@ -981,7 +980,7 @@ actually-existing directory." (let ((pathname (merge-pathnames* (component-relative-pathname component) - (component-parent-pathname component)))) + (pathname-directory-pathname (component-parent-pathname component))))) (unless (or (null pathname) (absolute-pathname-p pathname)) (error "Invalid relative pathname ~S for component ~S" pathname component)) (setf (slot-value component 'absolute-pathname) pathname) @@ -1055,9 +1054,9 @@ of which is a system object.") (gethash (coerce-name name) *defined-systems*)) (defun map-systems (fn) - "Apply `fn` to each defined system. + "Apply FN to each defined system. -`fn` should be a function of one argument. It will be +FN should be a function of one argument. It will be called with an object of type asdf:system." (maphash (lambda (_ datum) (declare (ignore _)) @@ -1143,8 +1142,8 @@ Going forward, we recommend new users should be using the source-registry. (let* ((*print-circle* nil) (message (format nil - "~@<While searching for system `~a`: `~a` evaluated ~ -to `~a` which is not a directory.~@:>" + "~@<While searching for system ~S: ~S evaluated ~ +to ~S which is not a directory.~@:>" system dir defaults))) (error message)) (remove-entry-from-registry () @@ -1975,15 +1974,15 @@ recursive calls to traverse.") (let ((operate-docstring "Operate does three things: -1. It creates an instance of `operation-class` using any keyword parameters +1. It creates an instance of OPERATION-CLASS using any keyword parameters as initargs. -2. It finds the asdf-system specified by `system` (possibly loading +2. It finds the asdf-system specified by SYSTEM (possibly loading it from disk). -3. It then calls `traverse` with the operation and system as arguments +3. It then calls TRAVERSE with the operation and system as arguments -The traverse operation is wrapped in `with-compilation-unit` and error -handling code. If a `version` argument is supplied, then operate also -ensures that the system found satisfies it using the `version-satisfies` +The traverse operation is wrapped in WITH-COMPILATION-UNIT and error +handling code. If a VERSION argument is supplied, then operate also +ensures that the system found satisfies it using the VERSION-SATISFIES method. Note that dependencies may cause the operation to invoke other @@ -2247,9 +2246,9 @@ Returns the new tree (which probably shares structure with the old one)" ;;;; years so everyone has time to migrate away from it. -- fare 2009-12-01 (defun run-shell-command (control-string &rest args) - "Interpolate `args` into `control-string` as if by `format`, and + "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and synchronously execute the result using a Bourne-compatible shell, with -output to `*verbose-out*`. Returns the shell's exit code." +output to *VERBOSE-OUT*. Returns the shell's exit code." (let ((command (apply #'format nil control-string args))) (asdf-message "; $ ~A~%" command) -- GitLab