Commit cd3992ff authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'fixes' into 'master'

Fixes

Various fixes.

See merge request !43
parents b63ee5fa bd65bcea
...@@ -144,8 +144,7 @@ by installing the source code, and running: ...@@ -144,8 +144,7 @@ by installing the source code, and running:
(asdf:load-system :uiop) ;; loading uiop is simple (asdf:load-system :uiop) ;; loading uiop is simple
(map () 'load ;; loading asdf/defsystem is tricky (map () 'load ;; loading asdf/defsystem is tricky
(mapcar 'asdf:component-pathname (asdf:input-files :concatenate-source-op "asdf/defsystem"))
(asdf::required-components :asdf/defsystem :keep-component 'asdf:cl-source-file)))
Note that the above can be adapted in a general recipe to get all the files in a system, in order. Note that the above can be adapted in a general recipe to get all the files in a system, in order.
To also have the files in systems it transitively depends on, add the `:other-systems t` keyword To also have the files in systems it transitively depends on, add the `:other-systems t` keyword
......
...@@ -359,12 +359,13 @@ using the JUST-DONE flag.")) ...@@ -359,12 +359,13 @@ using the JUST-DONE flag."))
(defgeneric compute-action-stamp (plan operation component &key just-done) (defgeneric compute-action-stamp (plan operation component &key just-done)
(:documentation "Has this action been successfully done already, (:documentation "Has this action been successfully done already,
and at what known timestamp has it been done at or will it be done at? and at what known timestamp has it been done at or will it be done at?
Takes two keywords JUST-DONE and PLAN: * PLAN is a plan object modelling future effects of actions,
or NIL to denote what actually happened.
* OPERATION and COMPONENT denote the action.
Takes keyword JUST-DONE:
* JUST-DONE is a boolean that is true if the action was just successfully performed, * JUST-DONE is a boolean that is true if the action was just successfully performed,
at which point we want compute the actual stamp and warn if files are missing; at which point we want compute the actual stamp and warn if files are missing;
otherwise we are making plans, anticipating the effects of the action. otherwise we are making plans, anticipating the effects of the action.
* PLAN is a plan object modelling future effects of actions,
or NIL to denote what actually happened.
Returns two values: Returns two values:
* a STAMP saying when it was done or will be done, * a STAMP saying when it was done or will be done,
or T if the action involves files that need to be recomputed. or T if the action involves files that need to be recomputed.
......
...@@ -88,9 +88,19 @@ itself.")) ...@@ -88,9 +88,19 @@ itself."))
(defmethod component-depends-on ((o gather-operation) (s system)) (defmethod component-depends-on ((o gather-operation) (s system))
(let* ((mono (operation-monolithic-p o)) (let* ((mono (operation-monolithic-p o))
(deps (deps
(required-components ;; Required-components only looks at the dependencies of an action, excluding the action
s :other-systems mono :component-type (if mono 'system '(not system)) ;; itself, so it may be safely used by an action recursing on its dependencies (which
:goal-operation 'load-op :keep-operation 'load-op))) ;; may or may not be an overdesigned API, since in practice we never use it that way).
;; Therefore, if we use :goal-operation 'load-op :keep-operation 'load-op, which looks
;; cleaner, we will miss the load-op on the requested system itself, which doesn't
;; matter for a regular system, but matters, a lot, for a package-inferred-system.
;; Using load-op as the goal operation and basic-compile-op as the keep-operation works
;; for our needs of gathering all the files we want to include in a bundle.
;; Note that we use basic-compile-op rather than compile-op so it will still work on
;; systems when *load-system-operation* is load-bundle-op.
(required-components
s :other-systems mono :component-type (if mono 'system '(not system))
:goal-operation 'load-op :keep-operation 'basic-compile-op)))
`((,(or (gather-operation o) (if mono 'lib-op 'compile-op)) ,@deps) `((,(or (gather-operation o) (if mono 'lib-op 'compile-op)) ,@deps)
,@(call-next-method)))) ,@(call-next-method))))
...@@ -120,6 +130,9 @@ On CLASP, ECL, MKCL, these object files _also_ include the contents of Lisp file ...@@ -120,6 +130,9 @@ On CLASP, ECL, MKCL, these object files _also_ include the contents of Lisp file
themselves. In any case, this operation will produce what you need to further build themselves. In any case, this operation will produce what you need to further build
a static runtime for your system, or a dynamic library to load in an existing runtime.")) a static runtime for your system, or a dynamic library to load in an existing runtime."))
;; What works: On ECL (and CLASP?), we link the .a output of lib-op into a .so;
;; on MKCL, we link the many .o files from the system directly into the .so;
;; on other implementations, we combine (usually concatenate) the .fasl files into one.
(defclass compile-bundle-op (basic-compile-bundle-op selfward-operation (defclass compile-bundle-op (basic-compile-bundle-op selfward-operation
#+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-operation) #+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-operation)
((selfward-operation :initform '(prepare-bundle-op #+(or clasp ecl) lib-op) ((selfward-operation :initform '(prepare-bundle-op #+(or clasp ecl) lib-op)
...@@ -476,9 +489,11 @@ or of opaque libraries shipped along the source code.")) ...@@ -476,9 +489,11 @@ or of opaque libraries shipped along the source code."))
(version (component-version s)) (version (component-version s))
(dependencies (dependencies
(if (operation-monolithic-p o) (if (operation-monolithic-p o)
;; We want only dependencies, and we use basic-load-op rather than load-op so that
;; this will keep working on systems when *load-system-operation* is load-bundle-op
(remove-if-not 'builtin-system-p (remove-if-not 'builtin-system-p
(required-components s :component-type 'system (required-components s :component-type 'system
:keep-operation 'load-op)) :keep-operation 'basic-load-op))
(while-collecting (x) ;; resolve the sideway-dependencies of s (while-collecting (x) ;; resolve the sideway-dependencies of s
(map-direct-dependencies (map-direct-dependencies
t 'load-op s t 'load-op s
...@@ -488,7 +503,8 @@ or of opaque libraries shipped along the source code.")) ...@@ -488,7 +503,8 @@ or of opaque libraries shipped along the source code."))
(depends-on (mapcar 'coerce-name dependencies))) (depends-on (mapcar 'coerce-name dependencies)))
(when (pathname-equal asd (system-source-file s)) (when (pathname-equal asd (system-source-file s))
(cerror "overwrite the asd file" (cerror "overwrite the asd file"
"~/asdf-action:format-action/ is going to overwrite the system definition file ~S which is probably not what you want; you probably need to tweak your output translations." "~/asdf-action:format-action/ is going to overwrite the system definition file ~S ~
which is probably not what you want; you probably need to tweak your output translations."
(cons o s) asd)) (cons o s) asd))
(with-open-file (s asd :direction :output :if-exists :supersede (with-open-file (s asd :direction :output :if-exists :supersede
:if-does-not-exist :create) :if-does-not-exist :create)
......
...@@ -62,9 +62,9 @@ into a single file")) ...@@ -62,9 +62,9 @@ into a single file"))
:with other-encodings = '() :with other-encodings = '()
:with around-compile = (around-compile-hook s) :with around-compile = (around-compile-hook s)
:with other-around-compile = '() :with other-around-compile = '()
:for c :in (required-components :for c :in (required-components ;; see note about similar call to required-components
s :goal-operation 'load-op s :goal-operation 'load-op ;; in bundle.lisp
:keep-operation 'load-op :keep-operation 'basic-compile-op
:other-systems (operation-monolithic-p operation)) :other-systems (operation-monolithic-p operation))
:append :append
(when (typep c 'cl-source-file) (when (typep c 'cl-source-file)
......
...@@ -200,8 +200,8 @@ contact maintainers if you need a stable API to do more than that.") ...@@ -200,8 +200,8 @@ contact maintainers if you need a stable API to do more than that.")
but not even registered as defined" but not even registered as defined"
:format-arguments (list name)))))) :format-arguments (list name))))))
(defun register-immutable-system (system-name &rest keys) (defun register-immutable-system (system-name &rest keys)
"Register SYSTEM-NAME as preloaded and immutable. "Register SYSTEM-NAME as preloaded and immutable.
It will automatically be considered as passed to FORCE-NOT in a plan." It will automatically be considered as passed to FORCE-NOT in a plan."
(let ((system-name (coerce-name system-name))) (let ((system-name (coerce-name system-name)))
(apply 'register-preloaded-system system-name keys) (apply 'register-preloaded-system system-name keys)
......
...@@ -24,6 +24,7 @@ ...@@ -24,6 +24,7 @@
;; (setf output-translations) between 2.27 and 3.0.3 was using a defsetf macro ;; (setf output-translations) between 2.27 and 3.0.3 was using a defsetf macro
;; for the sake of obsolete versions of GCL 2.6. Make sure it doesn't come to haunt us. ;; for the sake of obsolete versions of GCL 2.6. Make sure it doesn't come to haunt us.
#-mkcl ; mkcl 1.1.9 can't fmakunbound a setf function.
(when-upgrading (:version "3.1.2") (fmakunbound '(setf output-translations))) (when-upgrading (:version "3.1.2") (fmakunbound '(setf output-translations)))
(with-upgradability () (with-upgradability ()
...@@ -54,7 +55,7 @@ and the order is by decreasing length of namestring of the source pathname.") ...@@ -54,7 +55,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(pathname-directory (car x))))) (pathname-directory (car x)))))
(if (listp directory) (length directory) 0)))))))) (if (listp directory) (length directory) 0))))))))
new-value) new-value)
(defun* ((setf output-translations)) (new-value) (set-output-translations new-value)) (defun (setf output-translations) (new-value) (set-output-translations new-value))
(defun output-translations-initialized-p () (defun output-translations-initialized-p ()
"Have the output-translations been initialized yet?" "Have the output-translations been initialized yet?"
......
(defpackage :test-asdf/dll-user (:use)) ;; dummy, for package-inferred-system dependencies. (defpackage :test-asdf/dll-user (:use)) ;; dummy, for package-inferred-system dependencies.
(in-package :test-package) (in-package :asdf-test)
#+(and mkcl os-windows) #+(and mkcl os-windows)
(ffi:clines "extern __declspec(dllimport) int sample_function(void);") (ffi:clines "extern __declspec(dllimport) int sample_function(void);")
......
...@@ -3,9 +3,12 @@ ...@@ -3,9 +3,12 @@
(handler-case (asdf:find-system "duplicate-components") (handler-case (asdf:find-system "duplicate-components")
(asdf:duplicate-names (x) (declare (ignore x)) t) (asdf:duplicate-names (x) (declare (ignore x)) t)
(asdf:load-system-definition-error (x) (asdf:load-system-definition-error (x)
(if (and (asdf/find-system::error-condition x) (or (and (asdf/find-system::error-condition x)
(typep (asdf/find-system::error-condition x) 'asdf:duplicate-names)) (typep (asdf/find-system::error-condition x) 'asdf:duplicate-names))
t (progn
(error "LOAD-SYSTEM-DEFINITION-ERROR not as expected (no contained DUPLICATE-NAMES error)."))) (DBG :err (asdf/find-system::error-condition x))
(error "LOAD-SYSTEM-DEFINITION-ERROR not as expected ~%~
(no contained DUPLICATE-NAMES error)."))))
(:no-error (x) (:no-error (x)
(error "FIND-SYSTEM of duplicate-components returned ~S instead of raising DUPLICATE-NAMES error." x))) (error "FIND-SYSTEM of duplicate-components returned ~S ~%~
instead of raising DUPLICATE-NAMES error." x)))
(defpackage :test-asdf/monodll-1 (:use)) ;; dummy, for package-inferred-system dependencies. (defpackage :test-asdf/monodll-1 (:use)) ;; dummy, for package-inferred-system dependencies.
#+ecl (ffi:clines
(ffi:clines " "extern " #+mkcl "MKCL_DLLEXPORT " "int always_7() {
extern int always_7();
int always_7()
{
return 7;
}
")
#+clasp (leave-test "Not supported by CLASP yet" 0)
#+mkcl
(ffi:clines "
extern MKCL_DLLEXPORT int always_7(void);
int always_7(void)
{
return 7; return 7;
} }
") ")
(defpackage :test-asdf/monodll-user (:use)) ;; dummy, for package-inferred-system dependencies. (defpackage :test-asdf/monodll-user (:use)) ;; dummy, for package-inferred-system dependencies.
(in-package :test-package) (in-package :asdf-test)
(ffi:def-function "always_42" () :returning :int) (ffi:def-function "always_42" () :returning :int)
(defpackage :test-asdf/monodll (:use :test-asdf/monodll-1)) ;; dummy, for package-inferred-system dependencies. (defpackage :test-asdf/monodll (:use :test-asdf/monodll-1)) ;; dummy, for package-inferred-system dependencies.
#+ecl (ffi:clines
(ffi:clines " "extern int always_7();"
extern int always_42(); "extern " #+mkcl "MKCL_DLLEXPORT " "int always_42() {
int always_42()
{
return 6*always_7();
}
")
#+clasp (leave-test "Not supported by CLASP yet" 0)
#+mkcl
(ffi:clines "
extern MKCL_DLLEXPORT int always_42(void);
int always_42(void)
{
return 6*always_7(); return 6*always_7();
} }
") ")
...@@ -308,7 +308,7 @@ if ! type "$command" > /dev/null ; then ...@@ -308,7 +308,7 @@ if ! type "$command" > /dev/null ; then
exit 43 exit 43
fi fi
ASDFDIR="$(cd $(dirname $0)/.. ; /bin/pwd)" ASDFDIR="$(cd $(dirname $0)/.. ; command pwd)"
: ${bcmd:=$command $flags} ${icmd:=$command $flags} # batch and interactive : ${bcmd:=$command $flags} ${icmd:=$command $flags} # batch and interactive
if [ -z "${DEBUG_ASDF_TEST}" ] ; then if [ -z "${DEBUG_ASDF_TEST}" ] ; then
bcmd="$bcmd $nodebug" bcmd="$bcmd $nodebug"
......
...@@ -52,7 +52,6 @@ ...@@ -52,7 +52,6 @@
#+(or ecl mkcl) #+(or ecl mkcl)
(progn (progn
(DBG "On ECL and MKCL, test dll-op and monolithic-dll-op") (DBG "On ECL and MKCL, test dll-op and monolithic-dll-op")
#+ecl (trace c::builder)
(DBG "Test the pre-compiled system feature") (DBG "Test the pre-compiled system feature")
(require 'sockets) (require 'sockets)
(progn (progn
...@@ -68,8 +67,7 @@ ...@@ -68,8 +67,7 @@
(let* (#+(and mkcl os-windows) (compiler::*builder-default-libraries* (list (namestring dll)))) (let* (#+(and mkcl os-windows) (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/dll-user))) (operate 'load-op :test-asdf/dll-user)))
(DBG "Test that the DLL works") (DBG "Test that the DLL works")
(assert-equal (test-package::sample-function) 42) (assert-equal (sample-function) 42)
(DBG "Create a DLL via monolithic-dll-op") (DBG "Create a DLL via monolithic-dll-op")
(nest (nest
#+(and mkcl os-windows) #+(and mkcl os-windows)
...@@ -82,6 +80,6 @@ ...@@ -82,6 +80,6 @@
(si:load-foreign-module dll) (si:load-foreign-module dll)
(let* (#+(and mkcl os-windows) (compiler::*builder-default-libraries* (list (namestring dll)))) (let* (#+(and mkcl os-windows) (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/monodll-user))) (operate 'load-op :test-asdf/monodll-user)))
(assert-equal (test-package::always-42) 42)) (assert-equal (always-42) 42))
;;; TODO: test prebuilt-system. ;;; TODO: test prebuilt-system.
...@@ -108,7 +108,7 @@ ...@@ -108,7 +108,7 @@
(DBG "Checking that the bootstrap script and asdf.asd are in synch") (DBG "Checking that the bootstrap script and asdf.asd are in synch")
(defun system-lisp-files (system) (defun system-lisp-files (system)
(loop :for f :in (input-files 'concatenate-source-op system) (loop :for f :in (input-files 'concatenate-source-op system)
:collect (enough-pathname f *asdf-directory*))) :collect (unix-namestring (enough-pathname f *asdf-directory*))))
(DBG "Testing that the Makefile and ASDF agree on the order of UIOP files") (DBG "Testing that the Makefile and ASDF agree on the order of UIOP files")
(loop (loop
......
...@@ -19,22 +19,23 @@ ...@@ -19,22 +19,23 @@
(clear-caches-and-search) (clear-caches-and-search)
(assert (not (asdf:find-system "test-asdf/force1" nil))) (assert (not (asdf:find-system "test-asdf/force1" nil)))
(DBG "Correctly failed to find system.") (DBG "Correctly failed to find system.")
(defvar *attempts* 0)
(assert (assert
(let (tried-once) (with-asdf-cache (:override t)
(with-asdf-cache (:override t) (handler-bind
(handler-bind ((asdf:missing-component
((asdf:missing-component #'(lambda (c)
#'(lambda (c) (DBG "Caught MISSING-COMPONENT condition (A)." *attempts*)
(DBG "Caught MISSING-COMPONENT condition.") (if (zerop *attempts*)
(if (not tried-once) (let ((missing (asdf::missing-requires c)))
(let ((missing (asdf::missing-requires c))) (incf *attempts*)
(assert (equal missing "test-asdf/force1")) (assert (equal missing "test-asdf/force1"))
(setf tried-once t) (setf asdf:*central-registry* *old-registry*)
(setf asdf:*central-registry* *old-registry*) (invoke-restart 'asdf:retry))
(invoke-restart 'asdf:retry)) ;; avoid infinite looping
;; avoid infinite looping (leave-test 10 "Infinite loop while catching MISSING-COMPONENT")))))
(error c))))) (asdf:find-system "test-asdf/force1" t))))
(asdf:find-system "test-asdf/force1" t))))) (assert-equal *attempts* 1)
(DBG "Refinding test successful.") (DBG "Refinding test successful.")
...@@ -48,36 +49,37 @@ ...@@ -48,36 +49,37 @@
;; (trace find-component) ;; (trace find-component)
;; (trace asdf::component-find-path) ;; (trace asdf::component-find-path)
;; (trace operate) ;; (trace operate)
(let (tried-once) (setf *attempts* 0)
(with-asdf-cache (:override t) (with-asdf-cache (:override t)
(flet ((handle-missing (c) (flet ((handle-missing (c)
(if (not tried-once) (if (zerop *attempts*)
(let ((missing (asdf::missing-requires c))) (let ((missing (asdf::missing-requires c)))
(assert (equal missing "test-asdf/force1")) (incf *attempts*)
(setf tried-once t) (assert (equal missing "test-asdf/force1"))
(DBG "Trying to reset the central registry and retry.") (DBG "Trying to reset the central registry and retry.")
(setf asdf:*central-registry* *old-registry*) (setf asdf:*central-registry* *old-registry*)
(unless (find-restart 'asdf:clear-configuration-and-retry) (unless (find-restart 'asdf:clear-configuration-and-retry)
(error "Expected CLEAR-CONFIGURATION-AND-RETRY restart not found.")) (error "Expected CLEAR-CONFIGURATION-AND-RETRY restart not found."))
(DBG "Before invoking restart, CENTRAL-REGISTRY is:" (DBG "Before invoking restart, CENTRAL-REGISTRY is:"
asdf:*central-registry*) asdf:*central-registry*)
(invoke-restart 'asdf:clear-configuration-and-retry) (invoke-restart 'asdf:clear-configuration-and-retry)
(DBG "After invoking restart, CENTRAL-REGISTRY is:" (DBG "After invoking restart, CENTRAL-REGISTRY is:"
asdf:*central-registry*)) asdf:*central-registry*))
;; avoid infinite looping ;; avoid infinite looping
(error c)))) (leave-test 11 "Infinite loop while catching MISSING-COMPONENT"))))
(handler-bind (handler-bind
((asdf:missing-dependency-of-version ((asdf:missing-dependency-of-version
#'(lambda (c) #'(lambda (c)
;; Nothing Quicklisp can do to recover from this, so ;; Nothing Quicklisp can do to recover from this, so
;; just resignal ;; just resignal
(error c))) (error c)))
(asdf:missing-dependency (asdf:missing-dependency
#'(lambda (c) #'(lambda (c)
(DBG "Catching MISSING-DEPENDENCY condition:" tried-once) (DBG "Catching MISSING-DEPENDENCY condition (B):" *attempts*)
(handle-missing c))) (handle-missing c)))
(asdf:missing-component (asdf:missing-component
#'(lambda (c) #'(lambda (c)
(DBG "Catching MISSING-COMPONENT condition:" tried-once) (DBG "Catching MISSING-COMPONENT condition (C):" *attempts*)
(handle-missing c)))) (handle-missing c))))
(asdf:load-system "test-missing-dependency"))))) (asdf:load-system "test-missing-dependency"))))
(assert-equal *attempts* 1)
...@@ -6,51 +6,51 @@ ...@@ -6,51 +6,51 @@
(defparameter foo :test-asdf-location-change) (defparameter foo :test-asdf-location-change)
(with-expected-failure (#+ecl (not (asdf:version-satisfies (lisp-implementation-version) "16")) #+ecl (unless (version-satisfies (lisp-implementation-version) "16")
#-ecl nil) (leave-test "ECL only supports this test starting with 16.0.0" 0))
(DBG "load foo. Should load from xach-foo-1/")
(setf *central-registry* (list (subpathname *test-directory* "xach-foo-1/")))
(defparameter foo1 (find-system foo))
(assert-pathname-equal
(subpathname *test-directory* "xach-foo-1/test-asdf-location-change.asd")
(system-source-file foo1))
(assert-equal (mapcar 'component-name (component-children foo1)) '("a"))
(assert-pathname-equal
(subpathname *test-directory* "xach-foo-1/a.lisp")
(component-pathname (find-component foo1 "a")))
(assert-equal nil (find-component foo1 "b"))
(load-system foo)
(defparameter loaded (find-symbol* :loaded :first-version))
(assert-equal (symbol-value loaded) t)
(DBG "load foo again. Should not do anything -- already loaded") (DBG "load foo. Should load from xach-foo-1/")
(setf (symbol-value loaded) :test-that-we-dont-reload) (setf *central-registry* (list (subpathname *test-directory* "xach-foo-1/")))
(load-system foo) (defparameter foo1 (find-system foo))
(assert-equal (symbol-value loaded) :test-that-we-dont-reload) (assert-pathname-equal
(assert (not (find-package :second-version))) (subpathname *test-directory* "xach-foo-1/test-asdf-location-change.asd")
(system-source-file foo1))
(assert-equal (mapcar 'component-name (component-children foo1)) '("a"))
(assert-pathname-equal
(subpathname *test-directory* "xach-foo-1/a.lisp")
(component-pathname (find-component foo1 "a")))
(assert-equal nil (find-component foo1 "b"))
(load-system foo)
(defparameter loaded (find-symbol* :loaded :first-version))
(assert-equal (symbol-value loaded) t)
(DBG "Now, change registry so foo is found from xach-foo-2/") (DBG "load foo again. Should not do anything -- already loaded")
(setf *central-registry* (list (subpathname *test-directory* "xach-foo-2/"))) (setf (symbol-value loaded) :test-that-we-dont-reload)
(defparameter foo2 (find-system foo)) (load-system foo)
(assert (eq foo1 foo2)) ;; the object should be the same (assert-equal (symbol-value loaded) :test-that-we-dont-reload)
(assert-equal (mapcar 'component-name (component-children foo2)) '("a" "b")) (assert (not (find-package :second-version)))
(assert-pathname-equal
(subpathname *test-directory* "xach-foo-2/test-asdf-location-change.asd") (DBG "Now, change registry so foo is found from xach-foo-2/")
(system-source-file foo2)) (setf *central-registry* (list (subpathname *test-directory* "xach-foo-2/")))
(assert-pathname-equal (defparameter foo2 (find-system foo))
(subpathname *test-directory* "xach-foo-2/a.lisp") (assert (eq foo1 foo2)) ;; the object should be the same
(component-pathname (find-component foo2 "a"))) (assert-equal (mapcar 'component-name (component-children foo2)) '("a" "b"))
(assert-pathname-equal (assert-pathname-equal
(subpathname *test-directory* "xach-foo-2/b.lisp") (subpathname *test-directory* "xach-foo-2/test-asdf-location-change.asd")
(component-pathname (find-component foo2 "b"))) (system-source-file foo2))
(DBG "load foo yet again. It should see the pathname has changed and load it anew") (assert-pathname-equal
;;; ECL bug: this fails if we use load-bundle-op instead of load-op as *load-system-operation* (subpathname *test-directory* "xach-foo-2/a.lisp")
;;; in bundle.lisp. The test-asdf-location-change.fasb is linked and loaded, but that fails to (component-pathname (find-component foo2 "a")))
;;; create the :second-version package; loading the same .fasb in another ecl works fine, and (assert-pathname-equal
;;; defines (second-version:wtf). WTF? You can test this bug by uncommenting the (subpathname *test-directory* "xach-foo-2/b.lisp")
;;; (setf asdf::*load-system-operation* 'load-bundle-op) line at the beginning of this file. (component-pathname (find-component foo2 "b")))
;;; NB: works on MKCL. (DBG "load foo yet again. It should see the pathname has changed and load it anew")
(load-system foo) ;;; ECL bug: this fails if we use load-bundle-op instead of load-op as *load-system-operation*
(assert (symbol-value (find-symbol* :loaded :second-version))) ;;; in bundle.lisp. The test-asdf-location-change.fasb is linked and loaded, but that fails to
(assert-equal 42 (symbol-call :second-version :wtf)) ;;; create the :second-version package; loading the same .fasb in another ecl works fine, and
) ;;; defines (second-version:wtf). WTF? You can test this bug by uncommenting the
;;; (setf asdf::*load-system-operation* 'load-bundle-op) line at the beginning of this file.
;;; NB: works on MKCL.
(load-system foo)
(assert (symbol-value (find-symbol* :loaded :second-version)))
(assert-equal 42 (symbol-call :second-version :wtf))
Supports Markdown
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