Loading find-system.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -127,7 +127,7 @@ or NIL if not found." (defvar *preloaded-systems* (make-hash-table :test 'equal) "Registration table for preloaded systems.") (declaim (ftype (function (component) t) mark-component-preloaded)) ; defined in asdf/operate (declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/operate (defun make-preloaded-system (name keys) "Make a preloaded system of given NAME with build information from KEYS" Loading operate.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -198,7 +198,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (let* ((module (or (required-module s) (coerce-name s))) (*modules-being-required* (cons module *modules-being-required*))) (assert (null (component-children s))) (require module))) (require #-cmucl module #+cmucl (string-upcase module)))) (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments) (unless (and (length=n-p arguments 1) Loading test/test-require.script +23 −6 Original line number Diff line number Diff line Loading @@ -159,18 +159,26 @@ (assert-equal (component-version (registered-system "require-system/ordinary")) "2.0") ;;; We can't actually test portably loading an implementation-dependent module, ;;; because we don't know what modules does implementations ship, so we'll only ;;; test the feature on implementations that support hooking ASDF into CL:REQUIRE ;;; Which is most of the interesting ones, anyway. ;;; ASDF assumes that if a same-named system can be found by find-system, then ;;; it overrides any same-named implementation-dependent module (after downcasing) ;;; specified via (:require ...), so as to avoid recursive calls to asdf:operate from ;;; within plan execution, and any double-loading or infinite loop that could result. ;;; ;;; That means that we can't "just" test the (:require ...) feature portably by ;;; relying on the ASDF hook into CL:REQUIRE that many implementations provide. #+clisp (defparameter *dynmod-list* (mapcar 'pathname-name (directory-files (subpathname (lisp-implementation-directory) "dynmod/") "*.lisp"))) (defparameter *mod* (or #+abcl :abcl-contrib #+allegro :yacc #+clisp "zlib" ;; Has to be lower case! #+clisp (first (remove "asdf" *dynmod-list* :test 'equal)) #+(or clozure cmucl) :defsystem #+ecl :ecl-curl #+ecl :serve-event ;; loads faster than :ecl-quicklisp #+lispworks "comm" #+mkcl :walker #+sbcl :sb-md5 Loading @@ -179,14 +187,23 @@ (unless *mod* (leave-test "This implementation doesn't provide a known module" 0)) ;; Prevent ASDF from finding the modules as ASDF systems on ECL, MKCL, SBCL (and maybe more). (setf asdf::*system-definition-search-functions* (remove 'asdf::sysdef-source-registry-search asdf::*system-definition-search-functions*)) (asdf::clear-defined-systems) (clear-cache) (defun has-module-p (x) ;; note that the spec is case-sensitive, but we'll cast a wider net. (and (member x *modules* :test 'string-equal) t)) (DBG :before *modules*) (assert (not (find-system *mod* nil))) (assert (not (has-module-p *mod*))) (eval `(def-test-system :require-test :depends-on ((:require ,*mod*)))) (load-system :require-test) (DBG :after *modules*) (assert (has-module-p *mod*)) uiop/filesystem.lisp +2 −2 Original line number Diff line number Diff line Loading @@ -71,7 +71,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" (or (ignore-errors (truename p)) ;; this is here because trying to find the truename of a directory pathname WITHOUT supplying ;; a trailing directory separator, causes an error on some lisps. #+(or clisp gcl) (if-let (d (ensure-directory-pathname p)) (ignore-errors (truename d))))))) #+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d))))))) (defun safe-file-write-date (pathname) "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error." Loading Loading @@ -546,7 +546,7 @@ NILs." (let ((dir #+abcl extensions:*lisp-home* #+(or allegro clasp ecl mkcl) #p"SYS:" ;;#+clisp custom:*lib-directory* ; causes failure in asdf-pathname-test(!) #+clisp custom:*lib-directory* #+clozure #p"ccl:" #+cmucl (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:"))) #+gcl system::*system-directory* Loading uiop/pathname.lisp +7 −5 Original line number Diff line number Diff line Loading @@ -326,11 +326,13 @@ actually-existing directory." ((directory-pathname-p pathspec) pathspec) (t (handler-case (make-pathname :directory (append (or (normalize-pathname-directory-component (pathname-directory pathspec)) (list :relative)) (list (file-namestring pathspec))) :name nil :type nil :version nil :defaults pathspec))))) :name nil :type nil :version nil :defaults pathspec) (error (c) (call-function on-error (compatfmt "~@<error while trying to create a directory pathname for ~S: ~A~@:>") pathspec c))))))) ;;; Parsing filenames Loading Loading
find-system.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -127,7 +127,7 @@ or NIL if not found." (defvar *preloaded-systems* (make-hash-table :test 'equal) "Registration table for preloaded systems.") (declaim (ftype (function (component) t) mark-component-preloaded)) ; defined in asdf/operate (declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/operate (defun make-preloaded-system (name keys) "Make a preloaded system of given NAME with build information from KEYS" Loading
operate.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -198,7 +198,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (let* ((module (or (required-module s) (coerce-name s))) (*modules-being-required* (cons module *modules-being-required*))) (assert (null (component-children s))) (require module))) (require #-cmucl module #+cmucl (string-upcase module)))) (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments) (unless (and (length=n-p arguments 1) Loading
test/test-require.script +23 −6 Original line number Diff line number Diff line Loading @@ -159,18 +159,26 @@ (assert-equal (component-version (registered-system "require-system/ordinary")) "2.0") ;;; We can't actually test portably loading an implementation-dependent module, ;;; because we don't know what modules does implementations ship, so we'll only ;;; test the feature on implementations that support hooking ASDF into CL:REQUIRE ;;; Which is most of the interesting ones, anyway. ;;; ASDF assumes that if a same-named system can be found by find-system, then ;;; it overrides any same-named implementation-dependent module (after downcasing) ;;; specified via (:require ...), so as to avoid recursive calls to asdf:operate from ;;; within plan execution, and any double-loading or infinite loop that could result. ;;; ;;; That means that we can't "just" test the (:require ...) feature portably by ;;; relying on the ASDF hook into CL:REQUIRE that many implementations provide. #+clisp (defparameter *dynmod-list* (mapcar 'pathname-name (directory-files (subpathname (lisp-implementation-directory) "dynmod/") "*.lisp"))) (defparameter *mod* (or #+abcl :abcl-contrib #+allegro :yacc #+clisp "zlib" ;; Has to be lower case! #+clisp (first (remove "asdf" *dynmod-list* :test 'equal)) #+(or clozure cmucl) :defsystem #+ecl :ecl-curl #+ecl :serve-event ;; loads faster than :ecl-quicklisp #+lispworks "comm" #+mkcl :walker #+sbcl :sb-md5 Loading @@ -179,14 +187,23 @@ (unless *mod* (leave-test "This implementation doesn't provide a known module" 0)) ;; Prevent ASDF from finding the modules as ASDF systems on ECL, MKCL, SBCL (and maybe more). (setf asdf::*system-definition-search-functions* (remove 'asdf::sysdef-source-registry-search asdf::*system-definition-search-functions*)) (asdf::clear-defined-systems) (clear-cache) (defun has-module-p (x) ;; note that the spec is case-sensitive, but we'll cast a wider net. (and (member x *modules* :test 'string-equal) t)) (DBG :before *modules*) (assert (not (find-system *mod* nil))) (assert (not (has-module-p *mod*))) (eval `(def-test-system :require-test :depends-on ((:require ,*mod*)))) (load-system :require-test) (DBG :after *modules*) (assert (has-module-p *mod*))
uiop/filesystem.lisp +2 −2 Original line number Diff line number Diff line Loading @@ -71,7 +71,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" (or (ignore-errors (truename p)) ;; this is here because trying to find the truename of a directory pathname WITHOUT supplying ;; a trailing directory separator, causes an error on some lisps. #+(or clisp gcl) (if-let (d (ensure-directory-pathname p)) (ignore-errors (truename d))))))) #+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d))))))) (defun safe-file-write-date (pathname) "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error." Loading Loading @@ -546,7 +546,7 @@ NILs." (let ((dir #+abcl extensions:*lisp-home* #+(or allegro clasp ecl mkcl) #p"SYS:" ;;#+clisp custom:*lib-directory* ; causes failure in asdf-pathname-test(!) #+clisp custom:*lib-directory* #+clozure #p"ccl:" #+cmucl (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:"))) #+gcl system::*system-directory* Loading
uiop/pathname.lisp +7 −5 Original line number Diff line number Diff line Loading @@ -326,11 +326,13 @@ actually-existing directory." ((directory-pathname-p pathspec) pathspec) (t (handler-case (make-pathname :directory (append (or (normalize-pathname-directory-component (pathname-directory pathspec)) (list :relative)) (list (file-namestring pathspec))) :name nil :type nil :version nil :defaults pathspec))))) :name nil :type nil :version nil :defaults pathspec) (error (c) (call-function on-error (compatfmt "~@<error while trying to create a directory pathname for ~S: ~A~@:>") pathspec c))))))) ;;; Parsing filenames Loading