Commit bae381cb authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

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
......@@ -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))
......
......@@ -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))
......
......@@ -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.
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