Skip to content
Snippets Groups Projects
Commit bae381cb authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix images for ASDF-dependent systems on ECL

Recent ECLs have libasdf.a instead of asdf.a.

Not all bundle-op is a basic-compile-op (e.g. concatenate-source-op).
Declaring otherwise was causing asdf/defsystem to appear as a compiled
dependency, causing incorrect double inclusion of symbols in the link
when asdf was explicitly depended on.

Make sure to include only one of uiop or asdf as the fallback support file,
and only when neither uiop nor asdf is explicitly depended on.

Improve test-program.script for ECL.

This fixes https://bugs.launchpad.net/bugs/1660547
parent a6cf01ab
No related branches found
No related tags found
No related merge requests found
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
(in-package :asdf/bundle) (in-package :asdf/bundle)
(with-upgradability () (with-upgradability ()
(defclass bundle-op (basic-compile-op) (defclass bundle-op (operation)
;; NB: use of instance-allocated slots for operations is DEPRECATED ;; NB: use of instance-allocated slots for operations is DEPRECATED
;; and only supported in a temporary fashion for backward compatibility. ;; and only supported in a temporary fashion for backward compatibility.
;; Supported replacement: Define slots on program-system instead. ;; Supported replacement: Define slots on program-system instead.
...@@ -107,7 +107,7 @@ itself.")) ...@@ -107,7 +107,7 @@ itself."))
`((,go ,@deps) ,@(call-next-method)))) `((,go ,@deps) ,@(call-next-method))))
;; Create a single fasl for the entire library ;; 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 ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object
:allocation :class) :allocation :class)
(bundle-type :initform :fasl :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 ...@@ -516,6 +516,7 @@ which is probably not what you want; you probably need to tweak your output tran
(list (list
#+clasp (compile-file-pathname (make-pathname :name name :defaults "sys:") :output-type :object) #+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 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) #+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:")
#+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;"))))) #+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 ...@@ -527,27 +528,30 @@ which is probably not what you want; you probably need to tweak your output tran
:name (coerce-name name) :name (coerce-name name)
:static-library (resolve-symlinks* pathname)))) :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)) (defmethod component-depends-on :around ((o image-op) (c system))
(let ((next (call-next-method)) (let* ((next (call-next-method))
(deps (make-hash-table :test 'equal))) (deps (make-hash-table :test 'equal))
(loop* :for (do . dcs) :in next :do (linkable (loop* :for (do . dcs) :in next :collect
(loop :for dc :in dcs (cons do
:for dep = (and dc (resolve-dependency-spec c dc)) (loop :for dc :in dcs
:when dep :do (setf (gethash (coerce-name (component-system dep)) deps) t))) :for dep = (and dc (resolve-dependency-spec c dc))
(labels ((has-it-p (x) (gethash x deps)) :when dep
(ensure-linkable-system (x) :do (setf (gethash (coerce-name (component-system dep)) deps) t)
(unless (has-it-p x) :collect (or (and (typep dep 'system) (linkable-system dep)) dep))))))
(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)))))))
`((lib-op `((lib-op
,@(unless (no-uiop c) ,@(unless (no-uiop c)
(append (ensure-linkable-system "cmp") (list (linkable-system "cmp")
(or (ensure-linkable-system "uiop") (unless (or (gethash "uiop" deps) (gethash "asdf" deps))
(ensure-linkable-system "asdf"))))) (or (linkable-system "uiop")
,@next)))) (linkable-system "asdf")
"asdf")))))
,@linkable)))
(defmethod perform ((o link-op) (c system)) (defmethod perform ((o link-op) (c system))
(let* ((object-files (input-files o c)) (let* ((object-files (input-files o c))
......
...@@ -173,7 +173,7 @@ Some constraints: ...@@ -173,7 +173,7 @@ Some constraints:
(defun assert-pathname-equal-helper (qx x qy y) (defun assert-pathname-equal-helper (qx x qy y)
(cond (cond
((equal x y) ((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 #+mkcl
((acall :pathname-equal x y) ((acall :pathname-equal x y)
(format t "~S and ~S evaluate to functionaly equivalent paths, respectively:~% ~S~%and~% ~S~%" qx qy x y)) (format t "~S and ~S evaluate to functionaly equivalent paths, respectively:~% ~S~%and~% ~S~%" qx qy x y))
......
...@@ -131,13 +131,49 @@ ...@@ -131,13 +131,49 @@
:epilogue-code :epilogue-code
(progn (progn
(format t "~:[Look ma, no UIOP~;Oops, UIOP~]!~%" (find-package :uiop)) (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))) #+ecl (si:quit 0) #+mkcl (mk-ext:quit :exit-code 0)))
(operate 'program-op 'hello-no-uiop :force t) (operate 'program-op 'hello-no-uiop :force t)
(DBG :run (output-file 'program-op 'hello-no-uiop)) (DBG :run (output-file 'program-op 'hello-no-uiop))
(assert-equal (assert-equal
(run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop))) (run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop)))
:output :lines :error-output t) :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. ;;; TODO: include a regular system dependency and a prebuilt-system in the executable.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment