diff --git a/asdf.asd b/asdf.asd index 1275fbfdbc027fc0d2c2e0c0e1409c11469db539..c0ebd2da4ea5b4522a25296fa82c4b52fa5bd352 100644 --- a/asdf.asd +++ b/asdf.asd @@ -15,7 +15,7 @@ :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)))) diff --git a/defsystem.lisp b/defsystem.lisp index febebb1bc19e84bf62f806d94923a29918dcc628..40dcdb0aeed93d1c3db292ed253a1505aceff02b 100644 --- a/defsystem.lisp +++ b/defsystem.lisp @@ -30,7 +30,7 @@ ;; 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))))) @@ -169,7 +169,7 @@ ;; 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)) diff --git a/find-system.lisp b/find-system.lisp index cde6ea98e87954182cd1e945ab3fdf774dbecbca..b07dddeb206b642c8e9a3a18dc368155a1d625ee 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -133,9 +133,10 @@ called with an object of type asdf:system." (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. @@ -155,14 +156,14 @@ Going forward, we recommend new users should be using the source-registry. (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) @@ -279,16 +280,13 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (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)))) @@ -302,9 +300,11 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (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 diff --git a/header.lisp b/header.lisp index beb038f4f737bd6ee822adcdc3fa1c6ebee434c6..9b8ad4e61663e1c2cc5a75eaf404d5ff1751a8cb 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;; -*- 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>. diff --git a/pathname.lisp b/pathname.lisp index ddf331e6733f0e7091d10432c9d86067a4fac4d4..51d180211739204514b80983223cc5f974a8e265 100644 --- a/pathname.lisp +++ b/pathname.lisp @@ -9,6 +9,7 @@ #:*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* @@ -200,6 +201,27 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL." ;;; 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. @@ -853,8 +875,11 @@ For the latter case, we ought pick random suffix and atomically open it." `(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) @@ -1049,7 +1074,7 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." :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") diff --git a/source-registry.lisp b/source-registry.lisp index 2885a88c2ec01f08f16493497d7d3597f68b2b20..98d284be4494d2c153f4220036c9fa7be54fe47a 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -51,7 +51,7 @@ system names to pathnames of .asd files") (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*)) diff --git a/test/test-logical-pathname.script b/test/test-logical-pathname.script index fe3bb30443b4133113990df0b1b3d5a0af3be759..a182fc2e860420d2a4a82427d9685d9eea8dbfd3 100644 --- a/test/test-logical-pathname.script +++ b/test/test-logical-pathname.script @@ -50,6 +50,9 @@ ;; 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")) diff --git a/upgrade.lisp b/upgrade.lisp index ed4a234618d9e6339ba90d5d715c601b00ba24b6..49f4eeaf99dce8f9e555c97415c4736b55d7b17c 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -45,7 +45,7 @@ ;; "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))) diff --git a/version.lisp-expr b/version.lisp-expr index a8e926a0fffb425b986e05cc21a67b81f00664a2..dcb327564d3c84c50dc9a54572460e3187edbfbc 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.106" +"2.26.107"