diff --git a/bundle.lisp b/bundle.lisp index 6c64647c2945a6666561b94b03a1414db4c61bac..8582a486812003ff6c69a3279cb5378e30483300 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -21,7 +21,7 @@ (in-package :asdf/bundle) (with-upgradability () - (defclass bundle-op (basic-compile-op) + (defclass bundle-op (operation) ;; NB: use of instance-allocated slots for operations is DEPRECATED ;; and only supported in a temporary fashion for backward compatibility. ;; Supported replacement: Define slots on program-system instead. @@ -107,7 +107,7 @@ itself.")) `((,go ,@deps) ,@(call-next-method)))) ;; Create a single fasl for the entire library - (defclass basic-compile-bundle-op (bundle-op) + (defclass basic-compile-bundle-op (bundle-op basic-compile-op) ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object :allocation :class) (bundle-type :initform :fasl :allocation :class)) @@ -516,6 +516,7 @@ which is probably not what you want; you probably need to tweak your output tran (list #+clasp (compile-file-pathname (make-pathname :name name :defaults "sys:") :output-type :object) #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :lib) + #+ecl (compile-file-pathname (make-pathname :name (strcat "lib" name) :defaults "sys:") :type :lib) #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :object) #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:") #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;"))))) @@ -527,27 +528,30 @@ which is probably not what you want; you probably need to tweak your output tran :name (coerce-name name) :static-library (resolve-symlinks* pathname)))) + (defun linkable-system (x) + (or (if-let (s (find-system x)) + (and (system-source-file x) s)) + (if-let (p (system-module-pathname (coerce-name x))) + (make-prebuilt-system x p)))) + (defmethod component-depends-on :around ((o image-op) (c system)) - (let ((next (call-next-method)) - (deps (make-hash-table :test 'equal))) - (loop* :for (do . dcs) :in next :do - (loop :for dc :in dcs - :for dep = (and dc (resolve-dependency-spec c dc)) - :when dep :do (setf (gethash (coerce-name (component-system dep)) deps) t))) - (labels ((has-it-p (x) (gethash x deps)) - (ensure-linkable-system (x) - (unless (has-it-p x) - (or (if-let (s (find-system x)) - (and (system-source-directory x) - (list s))) - (if-let (p (system-module-pathname x)) - (list (make-prebuilt-system x p))))))) + (let* ((next (call-next-method)) + (deps (make-hash-table :test 'equal)) + (linkable (loop* :for (do . dcs) :in next :collect + (cons do + (loop :for dc :in dcs + :for dep = (and dc (resolve-dependency-spec c dc)) + :when dep + :do (setf (gethash (coerce-name (component-system dep)) deps) t) + :collect (or (and (typep dep 'system) (linkable-system dep)) dep)))))) `((lib-op ,@(unless (no-uiop c) - (append (ensure-linkable-system "cmp") - (or (ensure-linkable-system "uiop") - (ensure-linkable-system "asdf"))))) - ,@next)))) + (list (linkable-system "cmp") + (unless (or (gethash "uiop" deps) (gethash "asdf" deps)) + (or (linkable-system "uiop") + (linkable-system "asdf") + "asdf"))))) + ,@linkable))) (defmethod perform ((o link-op) (c system)) (let* ((object-files (input-files o c)) diff --git a/test/script-support.lisp b/test/script-support.lisp index eb7a8a5ccfcd6342d6ccb04d16947f3f2c029fdc..510c078867fe28b12b2ea9e73734d068cef01f22 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -173,7 +173,7 @@ Some constraints: (defun assert-pathname-equal-helper (qx x qy y) (cond ((equal x y) - (format t "~S and~% ~S both evaluate to same path:~% ~S~%" qx qy x)) + (format t "~S and~%~S both evaluate to same path:~% ~S~%" qx qy x)) #+mkcl ((acall :pathname-equal x y) (format t "~S and ~S evaluate to functionaly equivalent paths, respectively:~% ~S~%and~% ~S~%" qx qy x y)) diff --git a/test/test-program.script b/test/test-program.script index 54a9da51b832a158762fdb71e2ad992016244f6b..37ecb3de06b4cc869535db2e9f0b16b3fd172334 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -131,13 +131,49 @@ :epilogue-code (progn (format t "~:[Look ma, no UIOP~;Oops, UIOP~]!~%" (find-package :uiop)) - (format t "~:[But no TEST-PACKAGE :-(~;But TEST-PACKAGE~]!~%" (find-package :test-package)) + (format t "~:[But no TEST-PACKAGE :-(~;And TEST-PACKAGE~]!~%" (find-package :test-package)) + (format t "~:[And no ASDF~;But ASDF :-( ~]!~%" (find-package :asdf)) #+ecl (si:quit 0) #+mkcl (mk-ext:quit :exit-code 0))) (operate 'program-op 'hello-no-uiop :force t) (DBG :run (output-file 'program-op 'hello-no-uiop)) (assert-equal (run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop))) :output :lines :error-output t) - '("Look ma, no UIOP!" "But TEST-PACKAGE!"))) + '("Look ma, no UIOP!" "And TEST-PACKAGE!" "And no ASDF!")) + + (DBG "Now create an program with explicit ASDF dependency, without registered ASDF (use implementation-provided prebuilt)") + (trace c::builder) ;; component-depends-on input-files output-files + (assert-pathname-equal + (truename (pathname-directory-pathname (output-file 'lib-op (asdf/bundle::linkable-system "asdf")))) + (truename (lisp-implementation-directory))) + (def-test-system hello-asdf + :class program-system + :depends-on ("asdf") + :components ((:file "file1")) + :epilogue-code + (progn + (format t "~:[~Oops, no ASDF~;Look ma, ASDF~]!~%" (find-package :asdf)) + (format t "~:[But no TEST-PACKAGE :-( ~;And TEST-PACKAGE~]!~%" (find-package :test-package)) + (uiop:quit 0))) + (operate 'program-op 'hello-asdf :force t) + (DBG :run (output-file 'program-op 'hello-asdf)) + (assert-equal + (run-program `(,(native-namestring (output-file 'program-op 'hello-asdf))) + :output :lines :error-output t) + '("Look ma, ASDF!" "And TEST-PACKAGE!")) + + (DBG "Now create an program with explicit ASDF dependency") + (register-directory *asdf-directory*) + (with-asdf-cache (:override t) + (load-asd (subpathname *asdf-directory* "asdf.asd")) ;; force re-loading ASDF, from source + (assert-pathname-equal + (truename (pathname-directory-pathname (output-file 'lib-op (asdf/bundle::linkable-system "asdf")))) + (truename (resolve-output "asdf/"))) + (operate 'program-op 'hello-asdf :force t) + (DBG :run (output-file 'program-op 'hello-asdf)) + (assert-equal + (run-program `(,(native-namestring (output-file 'program-op 'hello-asdf))) + :output :lines :error-output t) + '("Look ma, ASDF!" "And TEST-PACKAGE!")))) ;;; TODO: include a regular system dependency and a prebuilt-system in the executable.