:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
- :version "2.26.106" ;; to be automatically updated by bin/bump-revision
+ :version "2.26.107" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf))))
;; and merged into that DIRECTORY as per SUBPATHNAME.
;; If no absolute pathname was found, we return NIL.
(check-type pathname (or null string pathname))
- (or (and (pathnamep pathname) (absolute-pathname-p pathname))
+ (or (and (pathnamep pathname) (absolute-pathname-p pathname) (resolve-symlinks* pathname))
(let* ((lisp-file-pathname (resolve-symlinks* (current-lisp-file-pathname))))
(when (absolute-pathname-p lisp-file-pathname)
(subpathname lisp-file-pathname pathname :type :directory)))))
;; we also need to remember it in a special variable *systems-being-defined*.
(with-system-definitions ()
(let* ((name (coerce-name name))
- (source-file (if sfp source-file (current-lisp-file-pathname)))
+ (source-file (if sfp source-file (resolve-symlinks* (current-lisp-file-pathname))))
(registered (system-registered-p name))
(registered! (if registered
(rplaca registered (safe-file-write-date source-file))
(cleanup-system-definition-search-functions)
(defun* search-for-system-definition (system)
- (some (let ((name (coerce-name system))) #'(lambda (x) (funcall x name)))
- (cons 'find-system-if-being-defined
- *system-definition-search-functions*)))
+ (with-pathname-defaults ()
+ (some (let ((name (coerce-name system))) #'(lambda (x) (funcall x name)))
+ (cons 'find-system-if-being-defined
+ *system-definition-search-functions*))))
(defvar *central-registry* nil
"A list of 'system directory designators' ASDF uses to find systems.
(defun* probe-asd (name defaults)
(block nil
(when (directory-pathname-p defaults)
- (let* ((file (probe-file* (subpathname defaults (strcat name ".asd")))))
+ (let* ((file (probe-file* (subpathname defaults name :type "asd"))))
(when file
(return file)))
#-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!)
(when (os-windows-p)
(let ((shortcut
(make-pathname
- :defaults defaults :version :newest :case :local
+ :defaults defaults :case :local
:name (strcat name ".asd")
:type "lnk")))
(when (probe-file* shortcut)
(pathname (or (and (typep found '(or pathname string)) (pathname found))
(and found-system (system-source-file found-system))
(and previous (system-source-file previous))))
+ (pathname (ensure-pathname (resolve-symlinks* pathname) :want-absolute t))
(foundp (and (or found-system pathname previous) t)))
(check-type found (or null pathname system))
(when foundp
- (setf pathname (resolve-symlinks* pathname))
- (when (and pathname (not (absolute-pathname-p pathname)))
- (setf pathname (ensure-pathname-absolute pathname))
- (when found-system
- (setf (system-source-file found-system) pathname)))
- (when (and previous (not (#-cormanlisp equal #+cormanlisp equalp
- (system-source-file previous) pathname)))
+ (when (and pathname found-system)
+ (setf (system-source-file found-system) pathname))
+ (when (and previous (not (pathname-equal (system-source-file previous) pathname)))
(setf (system-source-file previous) pathname)
(setf previous-time nil))
(values foundp found-system pathname previous previous-time))))
(declare (ignore foundp))
(when (and found-system (not previous))
(register-system found-system))
- (unless (and (equal pathname (and previous (system-source-file previous)))
- (stamp<= (safe-file-write-date pathname) previous-time))
- ;; only load when it's a different pathname, or newer file content
+ (when (and pathname
+ (not (and previous
+ (pathname-equal pathname (system-source-file previous))
+ (stamp<= (safe-file-write-date pathname) previous-time))))
+ ;; only load when it's a pathname that is different or has newer content
(load-sysdef name pathname))
(let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
(return
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.106: Another System Definition Facility.
+;;; This is ASDF 2.26.107: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
#:*resolve-symlinks*
;; Making and merging pathnames, portably
#:normalize-pathname-directory-component #:denormalize-pathname-directory-component
+ #:pathname-equal
#:merge-pathname-directory-components #:make-pathname* #:*unspecific-pathname-type*
#:make-pathname-component-logical #:make-pathname-logical
#:merge-pathnames*
;;; Some pathname predicates
+(defun* pathname-equal (p1 p2)
+ (when (stringp p1) (setf p1 (pathname p1)))
+ (when (stringp p2) (setf p2 (pathname p2)))
+ (flet ((normalize-component (x)
+ (and (not (member x '(nil :unspecific :newest (:relative)) :test 'equal)) x)))
+ (macrolet ((=? (&rest accessors)
+ (flet ((frob (x)
+ (reduce 'list (cons 'normalize-component accessors)
+ :initial-value x :from-end t)))
+ `(equal ,(frob 'p1) ,(frob 'p2)))))
+ (or (and (null p1) (null 2))
+ (and (pathnamep p1) (pathnamep p2)
+ (or (equal p1 p2)
+ (=? pathname-host)
+ (=? pathname-device)
+ (=? normalize-pathname-directory-component pathname-directory)
+ (=? pathname-name)
+ (=? pathname-type)
+ (=? pathname-version)))))))
+
+
(defun* absolute-pathname-p (pathspec)
"If PATHSPEC is a pathname or namestring object that parses as a pathname
possessing an :ABSOLUTE directory component, return the (parsed) pathname.
`(call-with-staging-pathname ,pathname-value #'(lambda (,pathname-var) ,@body)))
;;; Basic pathnames
+(defun* logical-pathname-p (x)
+ (typep x 'logical-pathname))
+
(defun* physical-pathname-p (x)
- (and (pathnamep x) (not (typep x 'logical-pathname))))
+ (and (pathnamep x) (not (logical-pathname-p x))))
(defun* sane-physical-pathname (&key defaults (keep t) fallback want-existing)
(flet ((sanitize (x)
:ensure-directory ensure-directory :want-relative want-relative))))
(check want-pathname (pathnamep p) "Expected a pathname, not NIL")
(unless pathname (return NIL))
- (check want-logical (typep p 'logical-pathname) "Expected a logical pathname")
+ (check want-logical (logical-pathname-p p) "Expected a logical pathname")
(check want-physical (physical-pathname-p p) "Expected a physical pathname")
(transform ensure-physical () (translate-logical-pathname p))
(check ensure-physical (physical-pathname-p p) "Could not translate to a physical pathname")
(register-clear-configuration-hook 'clear-source-registry)
(defparameter *wild-asd*
- (make-pathname* :directory nil :name *wild* :type "asd" :version :newest))
+ (make-pathname* :directory nil :name *wild* :type "asd"))
(defun* directory-asd-files (directory)
(directory-files directory *wild-asd*))
;; and it tries to load ASDF from a logical-pathname.
'(:source-registry (:tree #p"ASDF:test;")
:ignore-inherited-configuration))
- (load-system :test-logical-pathname :force t))
+ (load-system :test-logical-pathname :force t)
+ (let ((sys (find-system :test-logical-pathname)))
+ (assert (logical-pathname-p (component-pathname sys)))
+ (assert (logical-pathname-p (system-source-file sys)))))
(DBG "Done"))
;; "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.6.7" would be your seventh local modification of development version 2.345.6
- (asdf-version "2.26.106")
+ (asdf-version "2.26.107")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
common-lisp.net / projects/asdf/asdf.git / commitdiff
