diff --git a/bundle.lisp b/bundle.lisp index 6b240a380a594eedd48a8173aa4a1d9e7445026b..53e1bf44a87a0fba845419e21f8d74d8befd95fc 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -8,7 +8,7 @@ :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem) (:export #:bundle-op #:bundle-type #:program-system - #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files + #:bundle-system #:bundle-pathname-type #:direct-dependency-files #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p #:basic-compile-bundle-op #:prepare-bundle-op #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op @@ -66,7 +66,8 @@ itself.")) ;; operation on a system and its dependencies (:documentation "Abstract operation for linking files together")) (defclass gather-op (bundle-op) - ((gather-op :initform nil :allocation :class :reader gather-op)) + ((gather-op :initform nil :allocation :class :reader gather-op) + (gather-type :initform :no-output-file :allocation :class :reader gather-type)) (:documentation "Abstract operation for gathering many input files from a system")) (defun operation-monolithic-p (op) @@ -86,7 +87,9 @@ itself.")) ;; operation on a system and its dependencies ;; create a single fasl for the entire library (defclass basic-compile-bundle-op (bundle-op) - ((bundle-type :initform :fasl))) + ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object + :allocation :class) + (bundle-type :initform :fasl :allocation :class))) (defclass prepare-bundle-op (sideway-operation) ((sideway-operation @@ -94,7 +97,8 @@ itself.")) ;; operation on a system and its dependencies :allocation :class))) (defclass lib-op (link-op gather-op non-propagating-operation) - ((bundle-type :initform :lib)) + ((gather-type :initform :object :allocation :class) + (bundle-type :initform :lib :allocation :class)) (:documentation "Compile the system and produce linkable (.a) library for it. Compare with DLL-OP.")) @@ -120,24 +124,35 @@ faster and more resource efficient.")) ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above. (defclass dll-op (link-op gather-op non-propagating-operation) - ((bundle-type :initform :dll)) + ((gather-type :initform :object :allocation :class) + (bundle-type :initform :dll :allocation :class)) (:documentation "compile the system and produce dynamic (.so/.dll) library for it. Compare with LIB-OP.")) (defclass deliver-asd-op (basic-compile-op selfward-operation) - ((selfward-operation :initform '(compile-bundle-op #+(or clasp ecl mkcl) lib-op) :allocation :class)) + ((selfward-operation + ;; TODO: implement link-op on all implementations, and make that + ;; '(compile-bundle-op lib-op #-(or clasp ecl mkcl) dll-op) + :initform '(compile-bundle-op #+(or clasp ecl mkcl) lib-op) + :allocation :class)) (:documentation "produce an asd file for delivering the system as a single fasl")) (defclass monolithic-deliver-asd-op (monolithic-bundle-op deliver-asd-op) ((selfward-operation + ;; TODO: implement link-op on all implementations, and make that + ;; '(monolithic-compile-bundle-op monolithic-lib-op #-(or clasp ecl mkcl) monolithic-dll-op) :initform '(monolithic-compile-bundle-op #+(or clasp ecl mkcl) monolithic-lib-op) :allocation :class)) (:documentation "produce fasl and asd files for combined system and dependencies.")) - (defclass monolithic-compile-bundle-op (monolithic-bundle-op basic-compile-bundle-op - #+(or clasp ecl mkcl) link-op gather-op non-propagating-operation) - ((gather-op :initform #+(or clasp ecl mkcl) 'lib-op #-(or clasp ecl mkcl) 'compile-bundle-op :allocation :class)) + (defclass monolithic-compile-bundle-op + (monolithic-bundle-op basic-compile-bundle-op + #+(or clasp ecl mkcl) link-op gather-op non-propagating-operation) + ((gather-op :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op + :allocation :class) + (gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library + :allocation :class)) (:documentation "Create a single fasl for the system and its dependencies.")) (defclass monolithic-load-bundle-op (monolithic-bundle-op load-bundle-op) @@ -148,12 +163,13 @@ Compare with LIB-OP.")) (:documentation "Create a single linkable library for the system and its dependencies.")) (defclass monolithic-dll-op (monolithic-bundle-op dll-op non-propagating-operation) - ((bundle-type :initform :dll)) + ((gather-type :initform :static-library :allocation :class)) (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies.")) (defclass image-op (monolithic-bundle-op selfward-operation #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-op) ((bundle-type :initform :image) + #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class) (selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class)) (:documentation "create an image file from the system and its dependencies")) @@ -163,17 +179,29 @@ Compare with LIB-OP.")) (defun bundle-pathname-type (bundle-type) (etypecase bundle-type - ((eql :no-output-file) nil) ;; should we error out instead? - ((or null string) bundle-type) - ((eql :fasl) #-(or clasp ecl mkcl) (compile-file-type) #+(or clasp ecl mkcl) "fasb") - #+(or clasp ecl) - ((member :dll :lib :shared-library :static-library :program :object :program) - (compile-file-type :type bundle-type)) - ((member :image) #+allegro "dxl" #+(and clisp os-windows) "exe" #-(or allegro (and clisp os-windows)) "image") - ((member :dll :shared-library) (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) - ((member :lib :static-library) (os-cond ((os-unix-p) "a") - ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) - ((eql :program) (os-cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) + ((or null string) ;; pass through nil or string literal + bundle-type) + ((eql :no-output-file) ;; marker for a bundle-type that has NO output file + (error "No output file, therefore no pathname type")) + ((eql :fasl) ;; the type of a fasl + #-(or clasp ecl mkcl) (compile-file-type) ; on image-based platforms, used as input and output + #+(or clasp ecl mkcl) "fasb") ; on C-linking platforms, only used as output for system bundles + ((member :image) + #+allegro "dxl" + #+(and clisp os-windows) "exe" + #-(or allegro (and clisp os-windows)) "image") + ;; NB: on CLASP and ECL these implementations, we better agree with + ;; (compile-file-type :type bundle-type)) + ((eql :object) ;; the type of a linkable object file + (os-cond ((os-unix-p) "o") + ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "o" "obj")))) + ((member :lib :static-library) ;; the type of a linkable library + (os-cond ((os-unix-p) "a") + ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) + ((member :dll :shared-library) ;; the type of a shared library + (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) + ((eql :program) ;; the type of an executable program + (os-cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) (defun bundle-output-files (o c) (let ((bundle-type (bundle-type o))) @@ -238,16 +266,6 @@ Compare with LIB-OP.")) :force :force-not :plan-class) ;; TODO: refactor so we don't mix plan and operation arguments (operation-original-initargs instance)))) - (defun bundlable-file-p (pathname) - (let ((type (pathname-type pathname))) - (declare (ignorable type)) - (or #+(or clasp ecl) (or (equalp type (compile-file-type :type :object)) - (equalp type (compile-file-type :type :static-library))) - #+mkcl (or (equalp type (compile-file-type :fasl-p nil)) - #+(or unix mingw32 mingw64) (equalp type "a") ;; valid on Unix and MinGW - #+(and windows (not (or mingw32 mingw64))) (equalp type "lib")) - #+(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) (equalp type (compile-file-type))))) - (defgeneric* (trivial-system-p) (component)) (defun user-system-p (s) @@ -276,9 +294,14 @@ Compare with LIB-OP.")) (loop :for f :in (funcall key sub-o sub-c) :when (funcall test f) :do (collect f)))))) + (defun pathname-type-equal-function (type) + #'(lambda (p) (equal (pathname-type p) type))) + (defmethod input-files ((o gather-op) (c system)) (unless (eq (bundle-type o) :no-output-file) - (direct-dependency-files o c :test 'bundlable-file-p :key 'output-files))) + (direct-dependency-files + o c :key 'output-files + :test (pathname-type-equal-function (bundle-pathname-type (gather-type o)))))) (defun select-bundle-operation (type &optional monolithic) (ecase type diff --git a/lisp-action.lisp b/lisp-action.lisp index 992cb8e62e1db940b3c000914ddfb98df0394ed0..072fb2f3bccfeb3e33306c50c736160d5b859e44 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -89,7 +89,13 @@ &optional #+(or clasp ecl mkcl) object-file #+clisp lib-file - warnings-file) outputs + warnings-file &rest rest) outputs + ;; Allow for extra outputs that are not of type warnings-file + ;; The way we do it is kludgy. In ASDF4, output-files shall not be positional. + (declare (ignore rest)) + (when warnings-file + (unless (equal (pathname-type warnings-file) (warnings-file-type)) + (setf warnings-file nil))) (call-with-around-compile-hook c #'(lambda (&rest flags) (apply 'compile-file* input-file diff --git a/plan.lisp b/plan.lisp index e79394984072fcb7aa55dcb62282f1bb197c1cb9..dd3f84fafb329320d9b711863fb542365ecbfab6 100644 --- a/plan.lisp +++ b/plan.lisp @@ -224,7 +224,7 @@ the action of OPERATION on COMPONENT in the PLAN")) (latest-in (stamps-latest (cons dep-stamp in-stamps)))) (when (and missing-in (not just-done)) (return (values t nil)))) ;; collect timestamps from outputs, and exit early if any is missing - (let* ((out-files (output-files o c)) + (let* ((out-files (remove-if 'null (output-files o c))) (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) (missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f)) (earliest-out (stamps-earliest out-stamps))) diff --git a/test/test-bundle.script b/test/test-bundle.script index 20d9e4dc8977d5327ee7bbd404da85944e1cf55a..7683506552bf5070a971c0bfcad2d6b5b3610ebd 100644 --- a/test/test-bundle.script +++ b/test/test-bundle.script @@ -49,28 +49,35 @@ (operate 'monolithic-compile-bundle-op :test-asdf/bundle-2) (assert (probe-file *mono-bundle-2*)) -;;; Test dll-op and monolithic-dll-op on ECL and MKCL #+(or ecl mkcl) (progn + (DBG "On ECL and MKCL, test dll-op and monolithic-dll-op") #+ecl (trace c::builder) - (require 'sockets) ;; Test the pre-compiled system feature - ;; Test that we didn't break require for non-asdf modules + (DBG "Test the pre-compiled system feature") + (require 'sockets) (progn + (DBG "Test that we didn't break require for non-asdf modules") (pop #+ecl ext:*module-provider-functions* #+mkcl mk-ext:*module-provider-functions*) (require 'serve-event)) + (DBG "Create a DLL via dll-op") (operate 'dll-op :test-asdf/dll-test) + (DBG "Load the DLL") (let ((dll (first (output-files 'dll-op :test-asdf/dll-test)))) (si:load-foreign-module dll) + (DBG "Load a library that knows how to use the DLL") (let* (#+(and mkcl 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) + (DBG "Create a DLL via monolithic-dll-op") (nest #+(and mkcl windows) (let* ((lib (first (output-files (operate 'lib-op :test-asdf/monodll-1) :test-asdf/monodll-1))) (compiler::*builder-default-libraries* (list (namestring lib))))) (operate 'monolithic-dll-op :test-asdf/monodll)) + (DBG "Use and test that DLL") (let ((dll (first (output-files 'monolithic-dll-op :test-asdf/monodll)))) (si:load-foreign-module dll) (let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll))))