Commit 08566aa5 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Give better names to fasl-op and some other bundle operations, 

but make sure pre-3.1 names are still usable.
parent 51dacee2

bundle.lisp

+48 −32
Original line number Diff line number Diff line
@@ -10,7 +10,9 @@ 
   #:bundle-op #:bundle-op-build-args #:bundle-type

   #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files

   #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p

   #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op

   #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:binary-op #:monolithic-binary-op

   #:basic-compile-bundle-op #:prepare-bundle-op

   #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op

   #:lib-op #:monolithic-lib-op

   #:dll-op #:monolithic-dll-op

   #:deliver-asd-op #:monolithic-deliver-asd-op
@@ -84,44 +86,45 @@ itself.")) ;; operation on a system and its dependencies 
        ,@(call-next-method))))



  ;; create a single fasl for the entire library

  (defclass basic-fasl-op (bundle-op)

  (defclass basic-compile-bundle-op (bundle-op)

    ((bundle-type :initform :fasl)))



  (defclass prepare-fasl-op (sideway-operation)

    ((sideway-operation :initform #+(or ecl mkcl) 'load-fasl-op #-(or ecl mkcl) 'load-op :allocation :class)))

  (defclass prepare-bundle-op (sideway-operation)

    ((sideway-operation :initform #+(or ecl mkcl) 'load-bundle-op #-(or ecl mkcl) 'load-op

                        :allocation :class)))



  (defclass lib-op (link-op gather-op non-propagating-operation)

    ((bundle-type :initform :lib))

    (:documentation "compile the system and produce linkable (.a) library for it."))



  (defclass fasl-op (basic-fasl-op selfward-operation #+ecl link-op #-ecl gather-op)

    ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op) :allocation :class)))

  (defclass compile-bundle-op (basic-compile-bundle-op selfward-operation #+ecl link-op #-ecl gather-op)

    ((selfward-operation :initform '(prepare-bundle-op #+ecl lib-op) :allocation :class)))



  (defclass load-fasl-op (basic-load-op selfward-operation)

    ((selfward-operation :initform '(prepare-fasl-op fasl-op) :allocation :class)))

  (defclass load-bundle-op (basic-load-op selfward-operation)

    ((selfward-operation :initform '(prepare-bundle-op compile-bundle-op) :allocation :class)))



  ;; NB: since the monolithic-op's can't be sideway-operation's,

  ;; if we wanted lib-op, dll-op, deliver-asd-op to be sideway-operation's,

  ;; we'd have to have the monolithic-op not inherit from the main op,

  ;; but instead inherit from a basic-FOO-op as with basic-fasl-op above.

  ;; 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))

    (:documentation "compile the system and produce dynamic (.so/.dll) library for it."))



  (defclass deliver-asd-op (basic-compile-op selfward-operation)

    ((selfward-operation :initform '(fasl-op #+(or ecl mkcl) lib-op) :allocation :class))

    ((selfward-operation :initform '(compile-bundle-op #+(or 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 :initform '(monolithic-fasl-op #+(or ecl mkcl) monolithic-lib-op)

    ((selfward-operation :initform '(monolithic-compile-bundle-op #+(or ecl mkcl) monolithic-lib-op)

                         :allocation :class))

    (:documentation "produce fasl and asd files for combined system and dependencies."))



  (defclass monolithic-fasl-op (monolithic-bundle-op basic-fasl-op

  (defclass monolithic-compile-bundle-op (monolithic-bundle-op basic-compile-bundle-op

                                #+ecl link-op gather-op non-propagating-operation)

    ((gather-op :initform #+(or ecl mkcl) 'lib-op #-(or ecl mkcl) 'fasl-op :allocation :class))

    ((gather-op :initform #+(or ecl mkcl) 'lib-op #-(or ecl mkcl) 'compile-bundle-op :allocation :class))

    (:documentation "Create a single fasl for the system and its dependencies."))



  (defclass monolithic-lib-op (monolithic-bundle-op lib-op non-propagating-operation) ()
@@ -270,7 +273,7 @@ itself.")) ;; operation on a system and its dependencies 
      ((:lib :static-library)

       (if monolithic 'monolithic-lib-op 'lib-op))

      ((:fasl)

       (if monolithic 'monolithic-fasl-op 'fasl-op))

       (if monolithic 'monolithic-compile-bundle-op 'compile-bundle-op))

      ((:image)

       'image-op)

      ((:program)
@@ -302,26 +305,26 @@ itself.")) ;; operation on a system and its dependencies 
          files))))



;;;

;;; LOAD-FASL-OP

;;; LOAD-BUNDLE-OP

;;;

;;; This is like ASDF's LOAD-OP, but using monolithic fasl files.

;;; This is like ASDF's LOAD-OP, but using bundle fasl files.

;;;

(with-upgradability ()

  (defmethod component-depends-on ((o load-fasl-op) (c system))

  (defmethod component-depends-on ((o load-bundle-op) (c system))

    `((,o ,@(loop :for dep :in (component-sideway-dependencies c)

                  :collect (resolve-dependency-spec c dep)))

      (,(if (user-system-p c) 'fasl-op 'load-op) ,c)

      (,(if (user-system-p c) 'compile-bundle-op 'load-op) ,c)

      ,@(call-next-method)))



  (defmethod input-files ((o load-fasl-op) (c system))

  (defmethod input-files ((o load-bundle-op) (c system))

    (when (user-system-p c)

      (output-files (find-operation o 'fasl-op) c)))

      (output-files (find-operation o 'compile-bundle-op) c)))



  (defmethod perform ((o load-fasl-op) (c system))

  (defmethod perform ((o load-bundle-op) (c system))

    (when (input-files o c)

      (perform-lisp-load-fasl o c)))



  (defmethod mark-operation-done :after ((o load-fasl-op) (c system))

  (defmethod mark-operation-done :after ((o load-bundle-op) (c system))

    (mark-operation-done (find-operation o 'load-op) c)))



;;;
@@ -340,8 +343,6 @@ itself.")) ;; operation on a system and its dependencies 
    (perform-lisp-load-fasl o c))

  (defmethod perform ((o load-source-op) (c compiled-file))

    (perform (find-operation o 'load-op) c))

  (defmethod perform ((o load-fasl-op) (c compiled-file))

    (perform (find-operation o 'load-op) c))

  (defmethod perform ((o operation) (c compiled-file))

    nil))
@@ -355,7 +356,7 @@ itself.")) ;; operation on a system and its dependencies 
  (defmethod perform ((o link-op) (c prebuilt-system))

    nil)



  (defmethod perform ((o basic-fasl-op) (c prebuilt-system))

  (defmethod perform ((o basic-compile-bundle-op) (c prebuilt-system))

    nil)



  (defmethod perform ((o lib-op) (c prebuilt-system))
@@ -423,7 +424,7 @@ itself.")) ;; operation on a system and its dependencies 
          (terpri s)))))



  #-(or ecl mkcl)

  (defmethod perform ((o basic-fasl-op) (c system))

  (defmethod perform ((o basic-compile-bundle-op) (c system))

    (let* ((input-files (input-files o c))

           (fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test-not #'equalp))

           (non-fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test #'equalp))
@@ -442,12 +443,12 @@ itself.")) ;; operation on a system and its dependencies 
          (combine-fasls fasl-files output-file)))))



  (defmethod input-files ((o load-op) (s precompiled-system))

    (bundle-output-files (find-operation o 'fasl-op) s))

    (bundle-output-files (find-operation o 'compile-bundle-op) s))



  (defmethod perform ((o load-op) (s precompiled-system))

    (perform-lisp-load-fasl o s))



  (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system))

  (defmethod component-depends-on ((o load-bundle-op) (s precompiled-system))

    #+xcl (declare (ignorable o))

    `((load-op ,s) ,@(call-next-method))))
@@ -486,7 +487,7 @@ itself.")) ;; operation on a system and its dependencies 
  ;; But it might break systems with missing dependencies,

  ;; and there is a weird bug in test-xach-update-bug.script

  ;;(unless (use-ecl-byte-compiler-p)

  ;;  (setf *load-system-operation* 'load-fasl-op))

  ;;  (setf *load-system-operation* 'load-bundle-op))



  (defmethod perform ((o link-op) (c system))

    (let* ((object-files (input-files o c))
@@ -513,7 +514,7 @@ itself.")) ;; operation on a system and its dependencies 
    (apply #'compiler::build-static-library (output-file o s)

           :lisp-object-files (input-files o s) (bundle-op-build-args o)))



  (defmethod perform ((o basic-fasl-op) (s system))

  (defmethod perform ((o basic-compile-bundle-op) (s system))

    (apply #'compiler::build-bundle (output-file o s)

           :lisp-object-files (input-files o s) (bundle-op-build-args o)))
@@ -534,9 +535,24 @@ itself.")) ;; operation on a system and its dependencies 
#+(and (not asdf-use-unsafe-mac-bundle-op)

       (or (and ecl darwin)

           (and abcl darwin (not abcl-bundle-op-supported))))

(defmethod perform :before ((o basic-fasl-op) (c component))

(defmethod perform :before ((o basic-compile-bundle-op) (c component))

  (unless (featurep :asdf-use-unsafe-mac-bundle-op)

    (cerror "Continue after modifying *FEATURES*."

            "BASIC-FASL-OP bundle operations are not supported on Mac OS X for this lisp.~%~T~

            "BASIC-COMPILE-BUNDLE-OP operations are not supported on Mac OS X for this lisp.~%~T~

To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~

Please report to ASDF-DEVEL if this works for you.")))





;;; Backward compatibility with pre-3.1.1 names

(defclass fasl-op (selfward-operation)

  ((selfward-operation :initform 'compile-bundle-op :allocation :class)))

(defclass load-fasl-op (selfward-operation)

  ((selfward-operation :initform 'load-bundle-op :allocation :class)))

(defclass binary-op (selfward-operation)

  ((selfward-operation :initform 'deliver-asd-op :allocation :class)))

(defclass monolithic-fasl-op (selfward-operation)

  ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class)))

(defclass monolithic-load-fasl-op (selfward-operation)

  ((selfward-operation :initform 'monolithic-load-bundle-op :allocation :class)))

(defclass monolithic-binary-op (selfward-operation)

  ((selfward-operation :initform 'monolithic-deliver-asd-op :allocation :class)))

interface.lisp

+3 −1
Original line number Diff line number Diff line
@@ -36,7 +36,9 @@ 
   #:component-load-dependencies #:run-shell-command ; deprecated, do not use

   #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system

   #+ecl #:make-build

   #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op

   #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:binary-op #:monolithic-binary-op

   #:basic-compile-bundle-op #:prepare-bundle-op

   #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op

   #:lib-op #:dll-op #:deliver-asd-op #:program-op #:image-op

   #:monolithic-lib-op #:monolithic-dll-op #:monolithic-deliver-asd-op

   #:concatenate-source-op

test/test-bundle.script

+6 −6
Original line number Diff line number Diff line
@@ -29,16 +29,16 @@ 
  (when (version< version-nums "1.2.0")

    (leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)))



(defparameter *bundle-1* (output-file 'fasl-op :test-asdf/bundle-1))

(defparameter *bundle-2* (output-file 'fasl-op :test-asdf/bundle-2))

(defparameter *mono-bundle-2* (output-file 'monolithic-fasl-op :test-asdf/bundle-2))

(defparameter *bundle-1* (output-file 'compile-bundle-op :test-asdf/bundle-1))

(defparameter *bundle-2* (output-file 'compile-bundle-op :test-asdf/bundle-2))

(defparameter *mono-bundle-2* (output-file 'monolithic-compile-bundle-op :test-asdf/bundle-2))

(DBG :test-bundle *bundle-1* *bundle-2*)

(assert-equal (list *bundle-2*)

              (input-files 'load-fasl-op :test-asdf/bundle-2))

              (input-files 'load-bundle-op :test-asdf/bundle-2))

(delete-file-if-exists *bundle-1*)

(delete-file-if-exists *bundle-2*)

(delete-file-if-exists *mono-bundle-2*)

(operate 'load-fasl-op :test-asdf/bundle-2)

(operate 'load-bundle-op :test-asdf/bundle-2)

(DBG "Check that the bundles were indeed created.")

(assert (probe-file *bundle-2*))

(assert (probe-file *bundle-1*))
@@ -46,7 +46,7 @@ 
(assert (symbol-value (find-symbol* :*file1* :test-package)))

(assert (symbol-value (find-symbol* :*file3* :test-package)))

(DBG "Now for the mono-fasl")

(operate 'monolithic-fasl-op :test-asdf/bundle-2)

(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

test/test-xach-update-bug.script

+1 −1
Original line number Diff line number Diff line
@@ -44,7 +44,7 @@ 
;;; the test-asdf-location-change.fasb is linked and loaded,

;;; but that fails to create the :second-version package;

;;; loading the same .fasb in another ecl works fine, and defined (second-version:wtf). WTF?

;;; Test it by replacing load-op below by load-fasl-op, and trace load* and other functions.

;;; Test it by replacing load-op below by load-bundle-op, and trace load* and other functions.

(operate 'load-op foo)

(assert (symbol-value (find-symbol* :loaded :second-version)))

(assert-equal 42 (symbol-call :second-version :wtf))