Commit 3e5adea3 authored by Eric Timmons's avatar Eric Timmons Committed by Francois-Rene Rideau
Browse files

Package inferred systems and around-compile. 

Package inferred systems now inherit around-compile from their top-level
system. Added test in package-inferred-system-test suite.
parent 51993ce2

package-inferred-system.lisp

+6 −3
Original line number Diff line number Diff line
@@ -93,11 +93,12 @@ otherwise return a default system name computed from PACKAGE-NAME." 
      (remove t (mapcar 'package-name-system (package-dependencies defpackage-form)))

      (error 'package-inferred-system-missing-package-error :system system :pathname file)))



  (defun same-package-inferred-system-p (system name directory subpath dependencies)

  (defun same-package-inferred-system-p (system name directory subpath around-compile dependencies)

    (and (eq (type-of system) 'package-inferred-system)

         (equal (component-name system) name)

         (pathname-equal directory (component-pathname system))

         (equal dependencies (component-sideway-dependencies system))

         (equal around-compile (around-compile-hook system))

         (let ((children (component-children system)))

           (and (length=n-p children 1)

                (let ((child (first children)))
@@ -117,14 +118,16 @@ otherwise return a default system name computed from PACKAGE-NAME." 
                                     :truename *resolve-symlinks*)))

                (when (file-pathname-p f)

                  (let ((dependencies (package-inferred-system-file-dependencies f system))

                        (previous (cdr (system-registered-p system))))

                    (if (same-package-inferred-system-p previous system dir sub dependencies)

                        (previous (cdr (system-registered-p system)))

                        (around-compile (around-compile-hook top)))

                    (if (same-package-inferred-system-p previous system dir sub around-compile dependencies)

                        previous

                        (eval `(defsystem ,system

                                 :class package-inferred-system

                                 :source-file nil

                                 :pathname ,dir

                                 :depends-on ,dependencies

                                 :around-compile ,around-compile

                                 :components ((cl-source-file "lisp" :pathname ,sub)))))))))))))))



(with-upgradability ()

test/package-inferred-system-test.script

+3 −0
Original line number Diff line number Diff line
@@ -6,3 +6,6 @@ 


;; No such file.

(signals missing-component (load-system :package-inferred-system-test/f))



;; Test that around-compile is inherited by inferred systems.

(assert-equal 3 (symbol-call :package-inferred-system-test/a :add10 1)) ;; add10 must have been compiled in base 2

test/package-inferred-system-test/a.lisp

+17 −0
Original line number Diff line number Diff line 
(defpackage package-inferred-system-test/a (:use cl))



(in-package :package-inferred-system-test/a)



(eval-when (:compile-toplevel)

  (format t "This is compile-time and the *read-base* is ~D~%" *read-base*))

(eval-when (:load-toplevel)

  (format t "This is load-time and the *read-base* is ~D~%" *read-base*))

(eval-when (:execute)

  (format t "This is execute-time and *read-base* is ~D~%" *read-base*))



(defun tst (x)

  (1+ x))



(defun add10 (x)

  (+ x 10))



(format t "(add10 0) is (in decimal) ~D~%" (add10 0))

test/package-inferred-system-test/package-inferred-system-test.asd

+4 −1
Original line number Diff line number Diff line
@@ -3,4 +3,7 @@ 
(defsystem package-inferred-system-test

  :class package-inferred-system

  :defsystem-depends-on

  #.(unless (find-class 'package-inferred-system nil) '(:asdf-package-inferred-system)))
 
  #.(unless (find-class 'package-inferred-system nil) '(:asdf-package-inferred-system))

  :around-compile (lambda (thunk)

                    (let ((*read-base* 2))

                      (funcall thunk))))