Loading asdf.asd +1 −1 Original line number Original line Diff line number Diff line Loading @@ -14,7 +14,7 @@ :licence "MIT" :licence "MIT" :description "Another System Definition Facility" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems." :version "2.20.9" ;; to be automatically updated by bin/bump-revision :version "2.20.10" ;; to be automatically updated by bin/bump-revision :depends-on () :depends-on () :components :components ((:file "asdf") ((:file "asdf") Loading asdf.lisp +33 −18 Original line number Original line Diff line number Diff line ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; This is ASDF 2.20.9: Another System Definition Facility. ;;; This is ASDF 2.20.10: Another System Definition Facility. ;;; ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>. Loading Loading @@ -115,7 +115,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 (asdf-version "2.20.9") (asdf-version "2.20.10") (existing-asdf (find-class 'component nil)) (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) (already-there (equal asdf-version existing-version))) Loading Loading @@ -541,6 +541,20 @@ and NIL NAME, TYPE and VERSION components" (defun* ununspecific (x) (defun* ununspecific (x) (if (eq x :unspecific) nil x)) (if (eq x :unspecific) nil x)) (defun* make-pathname-component-logical (x) (typecase x ((eql :unspecific) nil) #+clisp (string (string-upcase x)) #+clisp (cons (mapcar 'make-pathname-component-logical x)) (t x))) (defun* make-pathname-logical (x) (make-pathname :directory (make-pathname-component-logical (pathname-directory x)) :name (make-pathname-component-logical (pathname-name x)) :type (make-pathname-component-logical (pathname-type x)) :defaults x)) (defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*)) (defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*)) "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that if the SPECIFIED pathname does not have an absolute directory, if the SPECIFIED pathname does not have an absolute directory, Loading @@ -560,7 +574,7 @@ Also, if either argument is NIL, then the other argument is returned unmodified. (type (or (pathname-type specified) (pathname-type defaults))) (type (or (pathname-type specified) (pathname-type defaults))) (version (or (pathname-version specified) (pathname-version defaults)))) (version (or (pathname-version specified) (pathname-version defaults)))) (labels ((unspecific-handler (p) (labels ((unspecific-handler (p) (if (typep p 'logical-pathname) #'ununspecific #'identity))) (if (typep p 'logical-pathname) #'make-pathname-component-logical #'identity))) (multiple-value-bind (host device directory unspecific-handler) (multiple-value-bind (host device directory unspecific-handler) (ecase (first directory) (ecase (first directory) ((:absolute) ((:absolute) Loading Loading @@ -1588,9 +1602,7 @@ Going forward, we recommend new users should be using the source-registry. (defun* probe-asd (name defaults) (defun* probe-asd (name defaults) (block nil (block nil (when (directory-pathname-p defaults) (when (directory-pathname-p defaults) (let ((file (make-pathname (let ((file (subpathname defaults (strcat name ".asd")))) :defaults defaults :name name :version :newest :case :local :type "asd"))) (when (probe-file* file) (when (probe-file* file) (return file))) (return file))) #-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!) #-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!) Loading Loading @@ -2359,9 +2371,7 @@ recursive calls to traverse.") (defun* ensure-all-directories-exist (pathnames) (defun* ensure-all-directories-exist (pathnames) (loop :for pn :in pathnames (loop :for pn :in pathnames :for pathname = (if (typep pn 'logical-pathname) :for pathname = (translate-logical-pathname pn) (translate-logical-pathname pn) pn) :do (ensure-directories-exist pathname))) :do (ensure-directories-exist pathname))) (defmethod perform :before ((operation compile-op) (c source-file)) (defmethod perform :before ((operation compile-op) (c source-file)) Loading Loading @@ -3925,23 +3935,29 @@ with a different configuration, so the configuration would be re-read then." (loop :for f :in entries (loop :for f :in entries :for p = (or (and (typep f 'logical-pathname) f) :for p = (or (and (typep f 'logical-pathname) f) (let* ((u (ignore-errors (funcall merger f)))) (let* ((u (ignore-errors (funcall merger f)))) ;; The first u avoids a cumbersome (truename u) error ;; The first u avoids a cumbersome (truename u) error. (and u (equal (ignore-errors (truename u)) f) u))) ;; At this point f should already be a truename, ;; but isn't quite in CLISP, for doesn't have :version :newest (and u (equal (ignore-errors (truename u)) (truename f)) u))) :when p :collect p) :when p :collect p) entries)) entries)) (defun* directory-files (directory &optional (pattern *wild-file*)) (defun* directory-files (directory &optional (pattern *wild-file*)) (setf directory (pathname directory)) (when (wild-pathname-p directory) (when (wild-pathname-p directory) (error "Invalid wild in ~S" directory)) (error "Invalid wild in ~S" directory)) (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) (error "Invalid file pattern ~S" pattern)) (error "Invalid file pattern ~S" pattern)) (when (typep directory 'logical-pathname) (setf pattern (make-pathname-logical pattern))) (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory))))) (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory))))) (filter-logical-directory-results (filter-logical-directory-results directory entries directory entries #'(lambda (f) #'(lambda (f) (make-pathname :defaults directory (make-pathname :defaults directory :name (pathname-name f) :type (ununspecific (pathname-type f)) :name (pathname-name f) :version (ununspecific (pathname-version f))))))) :type (make-pathname-component-logical (pathname-type f)) :version (make-pathname-component-logical (pathname-version f))))))) (defun* directory-asd-files (directory) (defun* directory-asd-files (directory) (directory-files directory *wild-asd*)) (directory-files directory *wild-asd*)) Loading Loading @@ -3974,15 +3990,14 @@ with a different configuration, so the configuration would be re-read then." #+(or cmu lispworks sbcl scl) x))) #+(or cmu lispworks sbcl scl) x))) (filter-logical-directory-results (filter-logical-directory-results directory dirs directory dirs (let ((prefix (normalize-pathname-directory-component (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory)) (pathname-directory directory)))) '(:absolute)))) ; because allegro returns NIL for #p"FOO:" #'(lambda (d) #'(lambda (d) (let ((dir (normalize-pathname-directory-component (let ((dir (normalize-pathname-directory-component (pathname-directory d)))) (pathname-directory d)))) (and (consp dir) (consp (cdr dir)) (and (consp dir) (consp (cdr dir)) (make-pathname (make-pathname :defaults directory :name nil :type nil :version nil :defaults directory :name nil :type nil :version nil :directory (append prefix (last dir)))))))))) :directory (append prefix (make-pathname-component-logical (last dir))))))))))) (defun* collect-asds-in-directory (directory collect) (defun* collect-asds-in-directory (directory collect) (map () collect (directory-asd-files directory))) (map () collect (directory-asd-files directory))) Loading test/test-logical-pathname.script +29 −21 Original line number Original line Diff line number Diff line Loading @@ -3,34 +3,42 @@ (load-asdf) (load-asdf) (setf (logical-pathname-translations "ASDF") (setf (logical-pathname-translations "ASDF") `(("**;*.asd.*" ,(make-pathname :type "asd" :defaults (resolve-location `(,*asdf-directory* :**/ :*.*.*)))) #+(or allegro clisp) ("**;*.asd" ,(resolve-location `(,*asdf-directory* :**/ #p"*.asd"))) `(("**;*.*.*" ,(asdf::wilden *asdf-directory*))) ("**;*.lisp.*" ,(make-pathname :type "lisp" :defaults (resolve-location `(,*asdf-directory* :**/ :*.*.*)))) #-(or allegro clisp) ("**;*.lisp" ,(resolve-location `(,*asdf-directory* :**/ #p"*.lisp"))) `(("**;*.asd.*" ,(make-pathname :type "asd" :defaults (asdf::wilden *asdf-directory*))) ("**;*.lisp.*" ,(make-pathname :type "lisp" :defaults (asdf::wilden *asdf-directory*))) ("**;*.*.*" ,(resolve-location ("**;*.*.*" ,(resolve-location `(,*asdf-directory* "tmp/fasls" :implementation "logical-host-asdf" :**/ :*.*.*))))) `(,*asdf-directory* "tmp/fasls" :implementation "logical-host-asdf") :wilden t)))) (quit-on-error (quit-on-error (format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd")) (format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd")) (format t "~S~%" (truename "ASDF:test;test-force.asd")) (format t "~S~%" (truename "ASDF:test;test-force.asd")) (progn (format t "Test logical pathnames in central registry~%") (format t "Test logical pathnames in central registry~%") (setf *central-registry* '("ASDF:test;")) (setf *central-registry* '(#p"ASDF:test;")) (initialize-source-registry '(:source-registry :ignore-inherited-configuration)) (initialize-source-registry '(:source-registry :ignore-inherited-configuration)) (load-system :test-force :force t) (load-system :test-force :force t)) (progn (format t "Test logical pathnames in source-registry, non-recursive~%") (format t "Test logical pathnames in source-registry, non-recursive~%") (clear-system :test-force) (clear-system :test-force) (setf *central-registry* '()) (setf *central-registry* '()) (initialize-source-registry (initialize-source-registry '(:source-registry (:directory "ASDF:test;") :ignore-inherited-configuration)) '(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration)) (load-system :test-force :force t) (load-system :test-force :force t)) #-allegro ;; Allegro 8.2 seems to have trouble with logical-pathnames. disable for now. (progn (format t "Test logical pathnames in source-registry, recursive~%") (format t "Test logical pathnames in source-registry, recursive~%") (clear-system :test-force) (clear-system :test-force) (setf *central-registry* '()) (setf *central-registry* '()) (initialize-source-registry (initialize-source-registry '(:source-registry (:tree "ASDF:") :ignore-inherited-configuration)) ;; Bug: Allegro Express 8.2 incorrectly reads #p"ASDF:" as relative. (load-system :test-force :force t) '(:source-registry (:tree #-allegro #p"ASDF:" #+allegro #.(asdf::pathname-root #p"ASDF")) :ignore-inherited-configuration)) (load-system :test-force :force t)) (format t "Done~%")) (format t "Done~%")) Loading
asdf.asd +1 −1 Original line number Original line Diff line number Diff line Loading @@ -14,7 +14,7 @@ :licence "MIT" :licence "MIT" :description "Another System Definition Facility" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems." :version "2.20.9" ;; to be automatically updated by bin/bump-revision :version "2.20.10" ;; to be automatically updated by bin/bump-revision :depends-on () :depends-on () :components :components ((:file "asdf") ((:file "asdf") Loading
asdf.lisp +33 −18 Original line number Original line Diff line number Diff line ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; This is ASDF 2.20.9: Another System Definition Facility. ;;; This is ASDF 2.20.10: Another System Definition Facility. ;;; ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>. Loading Loading @@ -115,7 +115,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 (asdf-version "2.20.9") (asdf-version "2.20.10") (existing-asdf (find-class 'component nil)) (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) (already-there (equal asdf-version existing-version))) Loading Loading @@ -541,6 +541,20 @@ and NIL NAME, TYPE and VERSION components" (defun* ununspecific (x) (defun* ununspecific (x) (if (eq x :unspecific) nil x)) (if (eq x :unspecific) nil x)) (defun* make-pathname-component-logical (x) (typecase x ((eql :unspecific) nil) #+clisp (string (string-upcase x)) #+clisp (cons (mapcar 'make-pathname-component-logical x)) (t x))) (defun* make-pathname-logical (x) (make-pathname :directory (make-pathname-component-logical (pathname-directory x)) :name (make-pathname-component-logical (pathname-name x)) :type (make-pathname-component-logical (pathname-type x)) :defaults x)) (defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*)) (defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*)) "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that if the SPECIFIED pathname does not have an absolute directory, if the SPECIFIED pathname does not have an absolute directory, Loading @@ -560,7 +574,7 @@ Also, if either argument is NIL, then the other argument is returned unmodified. (type (or (pathname-type specified) (pathname-type defaults))) (type (or (pathname-type specified) (pathname-type defaults))) (version (or (pathname-version specified) (pathname-version defaults)))) (version (or (pathname-version specified) (pathname-version defaults)))) (labels ((unspecific-handler (p) (labels ((unspecific-handler (p) (if (typep p 'logical-pathname) #'ununspecific #'identity))) (if (typep p 'logical-pathname) #'make-pathname-component-logical #'identity))) (multiple-value-bind (host device directory unspecific-handler) (multiple-value-bind (host device directory unspecific-handler) (ecase (first directory) (ecase (first directory) ((:absolute) ((:absolute) Loading Loading @@ -1588,9 +1602,7 @@ Going forward, we recommend new users should be using the source-registry. (defun* probe-asd (name defaults) (defun* probe-asd (name defaults) (block nil (block nil (when (directory-pathname-p defaults) (when (directory-pathname-p defaults) (let ((file (make-pathname (let ((file (subpathname defaults (strcat name ".asd")))) :defaults defaults :name name :version :newest :case :local :type "asd"))) (when (probe-file* file) (when (probe-file* file) (return file))) (return file))) #-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!) #-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!) Loading Loading @@ -2359,9 +2371,7 @@ recursive calls to traverse.") (defun* ensure-all-directories-exist (pathnames) (defun* ensure-all-directories-exist (pathnames) (loop :for pn :in pathnames (loop :for pn :in pathnames :for pathname = (if (typep pn 'logical-pathname) :for pathname = (translate-logical-pathname pn) (translate-logical-pathname pn) pn) :do (ensure-directories-exist pathname))) :do (ensure-directories-exist pathname))) (defmethod perform :before ((operation compile-op) (c source-file)) (defmethod perform :before ((operation compile-op) (c source-file)) Loading Loading @@ -3925,23 +3935,29 @@ with a different configuration, so the configuration would be re-read then." (loop :for f :in entries (loop :for f :in entries :for p = (or (and (typep f 'logical-pathname) f) :for p = (or (and (typep f 'logical-pathname) f) (let* ((u (ignore-errors (funcall merger f)))) (let* ((u (ignore-errors (funcall merger f)))) ;; The first u avoids a cumbersome (truename u) error ;; The first u avoids a cumbersome (truename u) error. (and u (equal (ignore-errors (truename u)) f) u))) ;; At this point f should already be a truename, ;; but isn't quite in CLISP, for doesn't have :version :newest (and u (equal (ignore-errors (truename u)) (truename f)) u))) :when p :collect p) :when p :collect p) entries)) entries)) (defun* directory-files (directory &optional (pattern *wild-file*)) (defun* directory-files (directory &optional (pattern *wild-file*)) (setf directory (pathname directory)) (when (wild-pathname-p directory) (when (wild-pathname-p directory) (error "Invalid wild in ~S" directory)) (error "Invalid wild in ~S" directory)) (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) (error "Invalid file pattern ~S" pattern)) (error "Invalid file pattern ~S" pattern)) (when (typep directory 'logical-pathname) (setf pattern (make-pathname-logical pattern))) (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory))))) (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory))))) (filter-logical-directory-results (filter-logical-directory-results directory entries directory entries #'(lambda (f) #'(lambda (f) (make-pathname :defaults directory (make-pathname :defaults directory :name (pathname-name f) :type (ununspecific (pathname-type f)) :name (pathname-name f) :version (ununspecific (pathname-version f))))))) :type (make-pathname-component-logical (pathname-type f)) :version (make-pathname-component-logical (pathname-version f))))))) (defun* directory-asd-files (directory) (defun* directory-asd-files (directory) (directory-files directory *wild-asd*)) (directory-files directory *wild-asd*)) Loading Loading @@ -3974,15 +3990,14 @@ with a different configuration, so the configuration would be re-read then." #+(or cmu lispworks sbcl scl) x))) #+(or cmu lispworks sbcl scl) x))) (filter-logical-directory-results (filter-logical-directory-results directory dirs directory dirs (let ((prefix (normalize-pathname-directory-component (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory)) (pathname-directory directory)))) '(:absolute)))) ; because allegro returns NIL for #p"FOO:" #'(lambda (d) #'(lambda (d) (let ((dir (normalize-pathname-directory-component (let ((dir (normalize-pathname-directory-component (pathname-directory d)))) (pathname-directory d)))) (and (consp dir) (consp (cdr dir)) (and (consp dir) (consp (cdr dir)) (make-pathname (make-pathname :defaults directory :name nil :type nil :version nil :defaults directory :name nil :type nil :version nil :directory (append prefix (last dir)))))))))) :directory (append prefix (make-pathname-component-logical (last dir))))))))))) (defun* collect-asds-in-directory (directory collect) (defun* collect-asds-in-directory (directory collect) (map () collect (directory-asd-files directory))) (map () collect (directory-asd-files directory))) Loading
test/test-logical-pathname.script +29 −21 Original line number Original line Diff line number Diff line Loading @@ -3,34 +3,42 @@ (load-asdf) (load-asdf) (setf (logical-pathname-translations "ASDF") (setf (logical-pathname-translations "ASDF") `(("**;*.asd.*" ,(make-pathname :type "asd" :defaults (resolve-location `(,*asdf-directory* :**/ :*.*.*)))) #+(or allegro clisp) ("**;*.asd" ,(resolve-location `(,*asdf-directory* :**/ #p"*.asd"))) `(("**;*.*.*" ,(asdf::wilden *asdf-directory*))) ("**;*.lisp.*" ,(make-pathname :type "lisp" :defaults (resolve-location `(,*asdf-directory* :**/ :*.*.*)))) #-(or allegro clisp) ("**;*.lisp" ,(resolve-location `(,*asdf-directory* :**/ #p"*.lisp"))) `(("**;*.asd.*" ,(make-pathname :type "asd" :defaults (asdf::wilden *asdf-directory*))) ("**;*.lisp.*" ,(make-pathname :type "lisp" :defaults (asdf::wilden *asdf-directory*))) ("**;*.*.*" ,(resolve-location ("**;*.*.*" ,(resolve-location `(,*asdf-directory* "tmp/fasls" :implementation "logical-host-asdf" :**/ :*.*.*))))) `(,*asdf-directory* "tmp/fasls" :implementation "logical-host-asdf") :wilden t)))) (quit-on-error (quit-on-error (format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd")) (format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd")) (format t "~S~%" (truename "ASDF:test;test-force.asd")) (format t "~S~%" (truename "ASDF:test;test-force.asd")) (progn (format t "Test logical pathnames in central registry~%") (format t "Test logical pathnames in central registry~%") (setf *central-registry* '("ASDF:test;")) (setf *central-registry* '(#p"ASDF:test;")) (initialize-source-registry '(:source-registry :ignore-inherited-configuration)) (initialize-source-registry '(:source-registry :ignore-inherited-configuration)) (load-system :test-force :force t) (load-system :test-force :force t)) (progn (format t "Test logical pathnames in source-registry, non-recursive~%") (format t "Test logical pathnames in source-registry, non-recursive~%") (clear-system :test-force) (clear-system :test-force) (setf *central-registry* '()) (setf *central-registry* '()) (initialize-source-registry (initialize-source-registry '(:source-registry (:directory "ASDF:test;") :ignore-inherited-configuration)) '(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration)) (load-system :test-force :force t) (load-system :test-force :force t)) #-allegro ;; Allegro 8.2 seems to have trouble with logical-pathnames. disable for now. (progn (format t "Test logical pathnames in source-registry, recursive~%") (format t "Test logical pathnames in source-registry, recursive~%") (clear-system :test-force) (clear-system :test-force) (setf *central-registry* '()) (setf *central-registry* '()) (initialize-source-registry (initialize-source-registry '(:source-registry (:tree "ASDF:") :ignore-inherited-configuration)) ;; Bug: Allegro Express 8.2 incorrectly reads #p"ASDF:" as relative. (load-system :test-force :force t) '(:source-registry (:tree #-allegro #p"ASDF:" #+allegro #.(asdf::pathname-root #p"ASDF")) :ignore-inherited-configuration)) (load-system :test-force :force t)) (format t "Done~%")) (format t "Done~%"))