Commit 33a2560f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix footer for MKCL and ECL.

Make sure we use the correct package for *load-hooks* on MKCL,
and on both implementations (and CLASP), use ensure-gethash correctly
by wrapping the default in a constantly since it is a function.
parent 10b0a6d3
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
#+(or abcl clasp cmucl clozure ecl mkcl sbcl) #+(or abcl clasp cmucl clozure ecl mkcl sbcl)
(:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext
#:*module-provider-functions* #:*module-provider-functions*
#+(or clasp ecl mkcl) #:*load-hooks*) #+(or clasp ecl) #:*load-hooks*)
#+mkcl (:import-from :si #:*load-hooks*)) #+mkcl (:import-from :si #:*load-hooks*))
(in-package :asdf/footer) (in-package :asdf/footer)
...@@ -36,10 +36,13 @@ ...@@ -36,10 +36,13 @@
(let ((results (multiple-value-list (funcall provider name)))) (let ((results (multiple-value-list (funcall provider name))))
(when (first results) (register-preloaded-system (coerce-name name))) (when (first results) (register-preloaded-system (coerce-name name)))
(values-list results))) (values-list results)))
(defun wrap-module-provider-function (provider)
(ensure-gethash provider *wrapped-module-provider*
(constantly
#'(lambda (module-name)
(wrap-module-provider provider module-name)))))
(setf *module-provider-functions* (setf *module-provider-functions*
(loop :for provider :in *module-provider-functions* :collect (mapcar #'wrap-module-provider-function *module-provider-functions*))))
(ensure-gethash provider *wrapped-module-provider*
#'(lambda (module-name) (wrap-module-provider provider module-name)))))))
#+cmucl ;; Hook into the CMUCL herald. #+cmucl ;; Hook into the CMUCL herald.
(with-upgradability () (with-upgradability ()
......
...@@ -456,6 +456,7 @@ ...@@ -456,6 +456,7 @@
(assert-equal (multiple-value-list (ensure-gethash 1 h 3)) '(2 t)) (assert-equal (multiple-value-list (ensure-gethash 1 h 3)) '(2 t))
(assert-equal (multiple-value-list (ensure-gethash 1 h '(error "foo"))) '(2 t)) (assert-equal (multiple-value-list (ensure-gethash 1 h '(error "foo"))) '(2 t))
(signals parse-error (ensure-gethash 2 h '(error parse-error))) (signals parse-error (ensure-gethash 2 h '(error parse-error)))
(assert-equal (multiple-value-list (ensure-gethash 2 h (lambda () 5))) '(5 nil))
(assert-equal (multiple-value-list (gethash 3 h nil)) '(nil nil)) (assert-equal (multiple-value-list (gethash 3 h nil)) '(nil nil))
(assert-equal (multiple-value-list (ensure-gethash 3 h nil)) '(nil nil)) (assert-equal (multiple-value-list (ensure-gethash 3 h nil)) '(nil nil))
(assert-equal (multiple-value-list (gethash 3 h 4)) '(nil t)) (assert-equal (multiple-value-list (gethash 3 h 4)) '(nil t))
......
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