Loading test/require-system.asd 0 → 100644 +20 −0 Original line number Diff line number Diff line (defsystem "require-system" :version "2.0" :depends-on ("require-system/immutable")) (defsystem "require-system/preloaded" :version "2.0") (defsystem "require-system/immutable" :version "2.0") (defsystem "require-system/not-loaded" :version "2.0") (defsystem "require-system/ordinary" :version "2.0") (defsystem "require-system/require" :version "2.0" :depends-on ((:require "require-system/module1") (:require "require-system/module2"))) (defsystem "require-system/depends" :version "2.0" :depends-on ("test-asdf/module1" "require-system-module2")) test/script-support.lisp +6 −1 Original line number Diff line number Diff line Loading @@ -31,7 +31,8 @@ Some constraints: #:leave-test #:def-test-system #:action-name #:in-plan-p #:test-source #:test-fasl #:resolve-output #:output-location #:quietly #:join-namestrings)) #:quietly #:join-namestrings #:clear-cache)) (in-package :asdf-test) Loading Loading @@ -729,6 +730,10 @@ is bound, write a message and exit on an error. If :for (n . morep) :on namestrings :do (format s "~A~@[~C~]" n (and morep separator))))) (defun clear-cache () ;; Or, should we preserve the timestamps? (clrhash (asymval :*asdf-cache*))) ;; These are shorthands for interactive debugging of test scripts: (!a common-lisp-user::debug-asdf debug-asdf Loading test/test-require.script 0 → 100644 +193 −0 Original line number Diff line number Diff line ;; -*- Lisp -*- ;;; This script verifies the invariants of both ;;; *function* REQUIRE-SYSTEM and *class* REQUIRE-SYSTEM. ;;; Based on work by Daniel Kochmański (import 'asdf::registered-system) (DBG "---- Tests related to the behavior of preloaded systems") (DBG "- Even dummy `preloaded-system' is listed in `already-loaded-systems'") (register-preloaded-system "test-preloaded-dummy" :version "1.0") (assert (registered-system "test-preloaded-dummy")) (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "- Loaded `preloaded-system' is listed in `already-loaded-systems'") (assert (component-loaded-p (registered-system "test-preloaded-dummy"))) (assert (member "test-preloaded-dummy" (already-loaded-systems) :test #'equal)) (DBG "- Dummy `preloaded-system' doesn't get overwritten by `require-system'") (require-system "test-preloaded-dummy") (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "- Dummy `preloaded-system' doesn't get overwritten by `load-system' because there is no alternative in the filesystem") (let ((system (registered-system "test-preloaded-dummy"))) (load-test-system "test-preloaded-dummy") (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0")) (DBG "- Function `clear-system' doesn't remove `preloaded-system'") (assert (not (clear-system "test-preloaded-dummy"))) (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "-`preloaded-system' overridden by defsystem") (def-test-system "test-preloaded-dummy" :version "2.0") (assert-equal (component-version (registered-system "test-preloaded-dummy")) "2.0") (DBG "- Function `clear-system' restores `preloaded-system'") (assert (not (clear-system "test-preloaded-dummy"))) (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "-`preloaded-system' overridden by find-system") (assert (not (registered-system "require-system/preloaded"))) (register-preloaded-system "require-system/preloaded" :version "1.0") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (assert (component-loaded-p (registered-system "require-system/preloaded"))) (find-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (DBG "-`find-system' doesn't make the new system loaded") (assert (not (component-loaded-p (registered-system "require-system/preloaded")))) (DBG "-`load-system' does") (load-system "require-system/preloaded") (assert (component-loaded-p (registered-system "require-system/preloaded"))) (DBG "- Function `clear-system' restores registered, preloaded `preloaded-system'") (assert (not (clear-system "require-system/preloaded"))) (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (assert (component-loaded-p (registered-system "require-system/preloaded"))) (assert (member "require-system/preloaded" (already-loaded-systems) :test #'equal)) (DBG "- Function `require-system' doesn't overwrite `preloaded-system'") (require-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (DBG "- Function `require-system' doesn't trigger a side-effect reloading system") ;;; `require-system' called `load-system' regardless if the system was ;;; loaded or not. While the `:force' and `:force-not' flags were ;;; handled correctly, `load-system' had a nasty side-effect which ;;; were overwriting our system loaded in-memory, so the second ;;; `require-system' loaded the new `asd'-defined system. (require-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (DBG "- System `preloaded-system' won't be reloaded on `require-system' when cache is empty") (clear-cache) (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (require-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (DBG "- Function `load-system' overwrites `preloaded-system'") (load-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (DBG "- Update the preloaded system version after loading from asd") (register-preloaded-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (assert (not (clear-system "require-system/preloaded"))) (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") ;; Not implemented: #| (deregister-preloaded-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (assert (clear-system "require-system/preloaded")) (assert (not (registered-system "require-system/preloaded"))) |# (DBG "---- Tests related to the behavior of immutable systems") (DBG "- Test function `register-immutable-system'") ;; Note: it's not immutable *yet*, but loaded from file. (assert-equal (component-version (registered-system "require-system/immutable")) "2.0") (clear-system "require-system/immutable") (def-test-system "require-system/immutable" :version "1.0" :depends-on ("require-system/not-loaded") :components ((:file "file1"))) (assert (not (component-loaded-p "require-system/immutable"))) (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (let ((system (registered-system "require-system/immutable"))) (register-immutable-system "require-system/immutable") (assert (eq system (registered-system "require-system/immutable")))) (assert (eq 'system (type-of (registered-system "require-system/immutable")))) (assert-equal 1 (length (component-children (registered-system "require-system/immutable")))) (assert (not (component-loaded-p "require-system/immutable"))) ;; *not* marked loaded (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (DBG "- Function `require-system' doesn't overwrite `immutable-system'") (require-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (assert (not (component-loaded-p "require-system/immutable"))) ;; *not* marked loaded (DBG "- Function `load-system' doesn't overwrite `immutable-system'") (load-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (assert (not (component-loaded-p "require-system/immutable"))) ;; *not* marked loaded (DBG "- Function `load-system' doesn't load an immutable system's dependencies") (assert (not (component-loaded-p "require-system/not-loaded"))) ;; *not* marked loaded (DBG "- Function `clear-system' leaves `immutable-system' loaded, but clears build information") (assert-equal 1 (length (component-children (registered-system "require-system/immutable")))) (assert (not (component-loaded-p "require-system/immutable"))) ;; still not marked loaded (clear-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (assert-equal 0 (length (component-children (registered-system "require-system/immutable")))) (assert (component-loaded-p "require-system/immutable")) ;; *YES* marked loaded! (DBG "- System `immutable-system' won't be reloaded when cache is empty") (clear-cache) (load-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (DBG "---- Tests related to the behavior of ordinary systems") (DBG "- Require-system doesn't replace already loaded system") (def-test-system "require-system/ordinary" :version "1.0") (asdf::mark-component-preloaded "require-system/ordinary") (assert (component-loaded-p "require-system/ordinary")) (require-system "require-system/ordinary") (assert-equal (component-version (registered-system "require-system/ordinary")) "1.0") (DBG "- Load-system loads system from the disk") (clear-cache) (load-system "require-system/ordinary") (assert-equal (component-version (registered-system "require-system/ordinary")) "2.0") ;;; We can't actually test portably loading an implementation-dependent module, ;;; because we don't know what modules does implementations ship, so we'll only ;;; test the feature on implementations that support hooking ASDF into CL:REQUIRE ;;; Which is most of the interesting ones, anyway. (defparameter *mod* (or #+abcl :abcl-contrib #+allegro :yacc #+clisp "zlib" ;; Has to be lower case! #+(or clozure cmucl) :defsystem #+ecl :ecl-curl #+lispworks "comm" #+mkcl :walker #+sbcl :sb-md5 #+scl :http-library)) (unless *mod* (leave-test "This implementation doesn't provide a known module" 0)) (defun has-module-p (x) ;; note that the spec is case-sensitive, but we'll cast a wider net. (and (member x *modules* :test 'string-equal) t)) (assert (not (find-system *mod* nil))) (assert (not (has-module-p *mod*))) (eval `(def-test-system :require-test :depends-on ((:require ,*mod*)))) (load-system :require-test) (assert (has-module-p *mod*)) Loading
test/require-system.asd 0 → 100644 +20 −0 Original line number Diff line number Diff line (defsystem "require-system" :version "2.0" :depends-on ("require-system/immutable")) (defsystem "require-system/preloaded" :version "2.0") (defsystem "require-system/immutable" :version "2.0") (defsystem "require-system/not-loaded" :version "2.0") (defsystem "require-system/ordinary" :version "2.0") (defsystem "require-system/require" :version "2.0" :depends-on ((:require "require-system/module1") (:require "require-system/module2"))) (defsystem "require-system/depends" :version "2.0" :depends-on ("test-asdf/module1" "require-system-module2"))
test/script-support.lisp +6 −1 Original line number Diff line number Diff line Loading @@ -31,7 +31,8 @@ Some constraints: #:leave-test #:def-test-system #:action-name #:in-plan-p #:test-source #:test-fasl #:resolve-output #:output-location #:quietly #:join-namestrings)) #:quietly #:join-namestrings #:clear-cache)) (in-package :asdf-test) Loading Loading @@ -729,6 +730,10 @@ is bound, write a message and exit on an error. If :for (n . morep) :on namestrings :do (format s "~A~@[~C~]" n (and morep separator))))) (defun clear-cache () ;; Or, should we preserve the timestamps? (clrhash (asymval :*asdf-cache*))) ;; These are shorthands for interactive debugging of test scripts: (!a common-lisp-user::debug-asdf debug-asdf Loading
test/test-require.script 0 → 100644 +193 −0 Original line number Diff line number Diff line ;; -*- Lisp -*- ;;; This script verifies the invariants of both ;;; *function* REQUIRE-SYSTEM and *class* REQUIRE-SYSTEM. ;;; Based on work by Daniel Kochmański (import 'asdf::registered-system) (DBG "---- Tests related to the behavior of preloaded systems") (DBG "- Even dummy `preloaded-system' is listed in `already-loaded-systems'") (register-preloaded-system "test-preloaded-dummy" :version "1.0") (assert (registered-system "test-preloaded-dummy")) (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "- Loaded `preloaded-system' is listed in `already-loaded-systems'") (assert (component-loaded-p (registered-system "test-preloaded-dummy"))) (assert (member "test-preloaded-dummy" (already-loaded-systems) :test #'equal)) (DBG "- Dummy `preloaded-system' doesn't get overwritten by `require-system'") (require-system "test-preloaded-dummy") (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "- Dummy `preloaded-system' doesn't get overwritten by `load-system' because there is no alternative in the filesystem") (let ((system (registered-system "test-preloaded-dummy"))) (load-test-system "test-preloaded-dummy") (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0")) (DBG "- Function `clear-system' doesn't remove `preloaded-system'") (assert (not (clear-system "test-preloaded-dummy"))) (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "-`preloaded-system' overridden by defsystem") (def-test-system "test-preloaded-dummy" :version "2.0") (assert-equal (component-version (registered-system "test-preloaded-dummy")) "2.0") (DBG "- Function `clear-system' restores `preloaded-system'") (assert (not (clear-system "test-preloaded-dummy"))) (assert-equal (component-version (registered-system "test-preloaded-dummy")) "1.0") (DBG "-`preloaded-system' overridden by find-system") (assert (not (registered-system "require-system/preloaded"))) (register-preloaded-system "require-system/preloaded" :version "1.0") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (assert (component-loaded-p (registered-system "require-system/preloaded"))) (find-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (DBG "-`find-system' doesn't make the new system loaded") (assert (not (component-loaded-p (registered-system "require-system/preloaded")))) (DBG "-`load-system' does") (load-system "require-system/preloaded") (assert (component-loaded-p (registered-system "require-system/preloaded"))) (DBG "- Function `clear-system' restores registered, preloaded `preloaded-system'") (assert (not (clear-system "require-system/preloaded"))) (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (assert (component-loaded-p (registered-system "require-system/preloaded"))) (assert (member "require-system/preloaded" (already-loaded-systems) :test #'equal)) (DBG "- Function `require-system' doesn't overwrite `preloaded-system'") (require-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (DBG "- Function `require-system' doesn't trigger a side-effect reloading system") ;;; `require-system' called `load-system' regardless if the system was ;;; loaded or not. While the `:force' and `:force-not' flags were ;;; handled correctly, `load-system' had a nasty side-effect which ;;; were overwriting our system loaded in-memory, so the second ;;; `require-system' loaded the new `asd'-defined system. (require-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (DBG "- System `preloaded-system' won't be reloaded on `require-system' when cache is empty") (clear-cache) (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (require-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "1.0") (DBG "- Function `load-system' overwrites `preloaded-system'") (load-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (DBG "- Update the preloaded system version after loading from asd") (register-preloaded-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (assert (not (clear-system "require-system/preloaded"))) (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") ;; Not implemented: #| (deregister-preloaded-system "require-system/preloaded") (assert-equal (component-version (registered-system "require-system/preloaded")) "2.0") (assert (clear-system "require-system/preloaded")) (assert (not (registered-system "require-system/preloaded"))) |# (DBG "---- Tests related to the behavior of immutable systems") (DBG "- Test function `register-immutable-system'") ;; Note: it's not immutable *yet*, but loaded from file. (assert-equal (component-version (registered-system "require-system/immutable")) "2.0") (clear-system "require-system/immutable") (def-test-system "require-system/immutable" :version "1.0" :depends-on ("require-system/not-loaded") :components ((:file "file1"))) (assert (not (component-loaded-p "require-system/immutable"))) (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (let ((system (registered-system "require-system/immutable"))) (register-immutable-system "require-system/immutable") (assert (eq system (registered-system "require-system/immutable")))) (assert (eq 'system (type-of (registered-system "require-system/immutable")))) (assert-equal 1 (length (component-children (registered-system "require-system/immutable")))) (assert (not (component-loaded-p "require-system/immutable"))) ;; *not* marked loaded (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (DBG "- Function `require-system' doesn't overwrite `immutable-system'") (require-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (assert (not (component-loaded-p "require-system/immutable"))) ;; *not* marked loaded (DBG "- Function `load-system' doesn't overwrite `immutable-system'") (load-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (assert (not (component-loaded-p "require-system/immutable"))) ;; *not* marked loaded (DBG "- Function `load-system' doesn't load an immutable system's dependencies") (assert (not (component-loaded-p "require-system/not-loaded"))) ;; *not* marked loaded (DBG "- Function `clear-system' leaves `immutable-system' loaded, but clears build information") (assert-equal 1 (length (component-children (registered-system "require-system/immutable")))) (assert (not (component-loaded-p "require-system/immutable"))) ;; still not marked loaded (clear-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (assert-equal 0 (length (component-children (registered-system "require-system/immutable")))) (assert (component-loaded-p "require-system/immutable")) ;; *YES* marked loaded! (DBG "- System `immutable-system' won't be reloaded when cache is empty") (clear-cache) (load-system "require-system/immutable") (assert-equal (component-version (registered-system "require-system/immutable")) "1.0") (DBG "---- Tests related to the behavior of ordinary systems") (DBG "- Require-system doesn't replace already loaded system") (def-test-system "require-system/ordinary" :version "1.0") (asdf::mark-component-preloaded "require-system/ordinary") (assert (component-loaded-p "require-system/ordinary")) (require-system "require-system/ordinary") (assert-equal (component-version (registered-system "require-system/ordinary")) "1.0") (DBG "- Load-system loads system from the disk") (clear-cache) (load-system "require-system/ordinary") (assert-equal (component-version (registered-system "require-system/ordinary")) "2.0") ;;; We can't actually test portably loading an implementation-dependent module, ;;; because we don't know what modules does implementations ship, so we'll only ;;; test the feature on implementations that support hooking ASDF into CL:REQUIRE ;;; Which is most of the interesting ones, anyway. (defparameter *mod* (or #+abcl :abcl-contrib #+allegro :yacc #+clisp "zlib" ;; Has to be lower case! #+(or clozure cmucl) :defsystem #+ecl :ecl-curl #+lispworks "comm" #+mkcl :walker #+sbcl :sb-md5 #+scl :http-library)) (unless *mod* (leave-test "This implementation doesn't provide a known module" 0)) (defun has-module-p (x) ;; note that the spec is case-sensitive, but we'll cast a wider net. (and (member x *modules* :test 'string-equal) t)) (assert (not (find-system *mod* nil))) (assert (not (has-module-p *mod*))) (eval `(def-test-system :require-test :depends-on ((:require ,*mod*)))) (load-system :require-test) (assert (has-module-p *mod*))