Commit 444d732f authored by Robert Goldman's avatar Robert Goldman

Merge branch 'fix-require-some-more' into 'master'

Fix require some more

This replaces !20 with a new branch name, to account for the widening in purpose.

See merge request !21
parents a1aa0b12 70b9388c
......@@ -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"
......@@ -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)
......@@ -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.
(defparameter *dynmod-list*
(mapcar 'pathname-name
(directory-files (subpathname (lisp-implementation-directory) "dynmod/") "*.lisp")))
(defparameter *mod*
#+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
......@@ -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*))
(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*))
......@@ -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."
......@@ -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*
......@@ -326,11 +326,13 @@ actually-existing directory."
((directory-pathname-p pathspec)
(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)))))
(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)
(error (c) (call-function on-error (compatfmt "~@<error while trying to create a directory pathname for ~S: ~A~@:>") pathspec c)))))))
;;; Parsing filenames
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment