Skip to content
Snippets Groups Projects
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
No related branches found
No related tags found
No related merge requests found
......@@ -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 ()
......
......@@ -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
(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))
......@@ -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))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment