Commit 5e85031c authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix monolithic-dll-op on ECL

Use required-components in a way that is more robust when
*load-system-operation* is load-bundle-op rather than load-op,
by using basic-compile-op and/or basic-load-op as the :keep-operation
rather than compile-op or load-op respectively.

Test-bundle was passing the first time around, but not the second time.
The first time, it was only passing because the appropriate file were
loaded while building the dependencies of the target monolithic dll;
but monolithic-dll-op was already buggy and not linking all these dependencies.
The second time around, there was no building step and the proper dependencies
had failed to be linked in, so the loading failed.

This fixes https://bugs.launchpad.net/asdf/+bug/1626994
parent 822e8afa
......@@ -94,11 +94,13 @@ itself."))
;; 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 compile-op as the keep-operation works
;; 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 'compile-op)))
:goal-operation 'load-op :keep-operation 'basic-compile-op)))
`((,(or (gather-operation o) (if mono 'lib-op 'compile-op)) ,@deps)
,@(call-next-method))))
......@@ -128,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
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
#+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-operation)
((selfward-operation :initform '(prepare-bundle-op #+(or clasp ecl) lib-op)
......@@ -484,9 +489,11 @@ or of opaque libraries shipped along the source code."))
(version (component-version s))
(dependencies
(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
(required-components s :component-type 'system
:keep-operation 'load-op))
:keep-operation 'basic-load-op))
(while-collecting (x) ;; resolve the sideway-dependencies of s
(map-direct-dependencies
t 'load-op s
......@@ -496,7 +503,8 @@ or of opaque libraries shipped along the source code."))
(depends-on (mapcar 'coerce-name dependencies)))
(when (pathname-equal asd (system-source-file s))
(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))
(with-open-file (s asd :direction :output :if-exists :supersede
:if-does-not-exist :create)
......
......@@ -64,7 +64,7 @@ into a single file"))
:with other-around-compile = '()
:for c :in (required-components ;; see note about similar call to required-components
s :goal-operation 'load-op ;; in bundle.lisp
:keep-operation 'compile-op
:keep-operation 'basic-compile-op
:other-systems (operation-monolithic-p operation))
:append
(when (typep c 'cl-source-file)
......
(defpackage :test-asdf/dll-user (:use)) ;; dummy, for package-inferred-system dependencies.
(in-package :test-package)
(in-package :asdf-test)
#+(and mkcl os-windows)
(ffi:clines "extern __declspec(dllimport) int sample_function(void);")
......
(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)
......@@ -52,7 +52,6 @@
#+(or ecl mkcl)
(progn
(DBG "On ECL and MKCL, test dll-op and monolithic-dll-op")
#+ecl (trace c::builder)
(DBG "Test the pre-compiled system feature")
(require 'sockets)
(progn
......@@ -68,8 +67,7 @@
(let* (#+(and mkcl os-windows) (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/dll-user)))
(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")
(nest
#+(and mkcl os-windows)
......@@ -82,6 +80,6 @@
(si:load-foreign-module dll)
(let* (#+(and mkcl os-windows) (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/monodll-user)))
(assert-equal (test-package::always-42) 42))
(assert-equal (always-42) 42))
;;; TODO: test prebuilt-system.
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