Commit d1a0cebb authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'iss23' into 'master' 

Iss23

See merge request !132
parents a65c4cd3 c213e319

bundle.lisp

+14 −5
Original line number Diff line number Diff line
@@ -249,7 +249,7 @@ for all the linkable object files associated with the system or its dependencies 
                                     "--all-systems"

                                     ;; These use a different type .fasb or .a instead of .fasl

                                     #-(or clasp ecl mkcl) "--system"))))

                          (format nil "~A~@[~A~]" (component-name c) suffix))))

                          (format nil "~A~@[~A~]" (coerce-filename (component-name c)) suffix))))

              (type (bundle-pathname-type bundle-type)))

          (values (list (subpathname (component-pathname c) name :type type))

                  (eq (class-of o) (coerce-class (component-build-operation c)
@@ -420,14 +420,23 @@ or of opaque libraries shipped along the source code.")) 
;;;

(with-upgradability ()

  (defmethod output-files ((o deliver-asd-op) (s system))

    (list (make-pathname :name (component-name s) :type "asd"

    (list (make-pathname :name (coerce-filename (component-name s)) :type "asd"

                         :defaults (component-pathname s))))



  ;; because of name collisions between the output files of different

  ;; subclasses of DELIVER-ASD-OP, we cannot trust the file system to

  ;; tell us if the output file is up-to-date, so just treat the

  ;; operation as never being done.

  (defmethod operation-done-p ((o deliver-asd-op) (s system))

    (declare (ignorable o s))

    nil)



  (defmethod perform ((o deliver-asd-op) (s system))

    "Write an ASDF system definition for loading S as a delivered system."

    (let* ((inputs (input-files o s))

           (fasl (first inputs))

           (library (second inputs))

           (asd (first (output-files o s)))

           (asd (output-file o s))

           (name (if (and fasl asd) (pathname-name asd) (return-from perform)))

           (version (component-version s))

           (dependencies
@@ -439,7 +448,7 @@ or of opaque libraries shipped along the source code.")) 
                                                       :keep-operation 'basic-load-op))

                 (while-collecting (x) ;; resolve the sideway-dependencies of s

                   (map-direct-dependencies

                    'load-op s

                    'prepare-op s

                    #'(lambda (o c)

                        (when (and (typep o 'load-op) (typep c 'system))

                          (x c)))))))
@@ -474,7 +483,7 @@ which is probably not what you want; you probably need to tweak your output tran 
    (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))

           (output-files (output-files o c))

           (output-files (output-files o c)) ; can't use OUTPUT-FILE fn because possibility it's NIL

           (output-file (first output-files)))

      (assert (eq (not input-files) (not output-files)))

      (when input-files

test/deliver-bundle.asd

0 → 100644
+10 −0
Original line number Diff line number Diff line 
;;;---------------------------------------------------------------------------

;;; This system is to be used to test the generation of ASD files by

;;; DELIVER-ASD-OP.  See test-bundle-asd.script.

;;;---------------------------------------------------------------------------





(defsystem :deliver-bundle

    :defsystem-depends-on ("file3-only")

  :depends-on ("test-asdf/bundle-2")

  :components ((:file "file4")))

test/test-asdf.asd

+0 −1
Original line number Diff line number Diff line
@@ -108,4 +108,3 @@ 
  :version "0"

  :depends-on (:test-asdf/all)

  :components ((:file "properly-upgraded")))

test/test-bundle-asd.script

0 → 100644
+76 −0
Original line number Diff line number Diff line 
;;; -*- Lisp -*-

(in-package :asdf-test)

(use-package :asdf)



;;;---------------------------------------------------------------------------

;;; Test for GitLab issue 23

;;;---------------------------------------------------------------------------



(defparameter *test-system-name* "deliver-bundle")



(asdf:initialize-source-registry '(:source-registry

                                   (:directory :here)

                                   :ignore-inherited-configuration))

(asdf:clear-system *test-system-name*)





(defparameter *constructed-asdf-file*

  (output-file (make-operation 'deliver-asd-op)

                    (find-system *test-system-name*)))



(ignore-errors (delete-file *constructed-asdf-file*))



(DBG "Writing ASD system definition file:" *constructed-asdf-file*)



(operate 'deliver-asd-op *test-system-name*)



(defun load-constructed-asd-file (&optional (constructed-file *constructed-asdf-file*))

  (with-open-file (str constructed-file)

    (let* ((sexps

            (uiop:with-safe-io-syntax (:package :asdf-user)

              (uiop:read-file-forms str))))

      (or (find-if #'(lambda (x) (and (listp x) (eq (car x) 'defsystem))) sexps)

          (error "Unable to find generated defsystem.")))))



(defparameter *defsystem-sexpr*

  (load-constructed-asd-file))



(DBG "ASDF-created system definition is:")

(DBG (format nil "~s" *defsystem-sexpr*))



(assert (equalp (second *defsystem-sexpr*) *test-system-name*))

(assert (eq (getf *defsystem-sexpr* :class) 'asdf/bundle:prebuilt-system))

(assert (equalp (getf *defsystem-sexpr* :components)

                #-(or clasp ecl mkcl)

                `((:compiled-file ,(format nil "~a--system" *test-system-name*)))

                #+(or clasp ecl mkcl)

                '((:COMPILED-FILE "deliver-bundle"))))

#+(and (or clasp ecl mkcl) linux)

(assert (equalp (getf *defsystem-sexpr* :lib)

                "deliver-bundle.a"))

(assert (not (getf *defsystem-sexpr* :defsystem-depends-on)))

(assert (equalp (getf *defsystem-sexpr* :depends-on) (list "test-asdf/bundle-2"))

        nil "Dependencies for bundled system are incorrect.")



(ignore-errors (delete-file *constructed-asdf-file*))



(operate 'monolithic-deliver-asd-op *test-system-name*)



(setf *defsystem-sexpr*

      (load-constructed-asd-file))



(DBG "ASDF-created MONOLITHIC system definition is:")

(DBG (format nil "~s" *defsystem-sexpr*))



(assert (equalp (second *defsystem-sexpr*) *test-system-name*))

(assert (eq (getf *defsystem-sexpr* :class) 'asdf/bundle:prebuilt-system))

(assert (equalp (getf *defsystem-sexpr* :components)

                #-(or clasp ecl mkcl)

                `((:compiled-file ,(format nil "~a--all-systems" *test-system-name*)))

                #+ (or clasp ecl mkcl)

                '((:COMPILED-FILE "deliver-bundle--all-systems"))))

#+(and (or clasp ecl mkcl) linux)

(assert (equalp (getf *defsystem-sexpr* :lib)

                "deliver-bundle--all-systems.a"))

(assert (not (getf *defsystem-sexpr* :defsystem-depends-on)))

(assert (not (getf *defsystem-sexpr* :depends-on)))

uiop/configuration.lisp

+1 −1
Original line number Diff line number Diff line
@@ -203,7 +203,7 @@ directive.") 
            (if wilden (wilden p) p))))

       ((eql :home) (user-homedir-pathname))

       ((eql :here) (resolve-absolute-location

                     (or *here-directory* (pathname-directory-pathname (load-pathname)))

                     (or *here-directory* (pathname-directory-pathname (truename (load-pathname))))

                     :ensure-directory t :wilden nil))

       ((eql :user-cache) (resolve-absolute-location

                           *user-cache* :ensure-directory t :wilden nil)))