Commit 8c10cdbc authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Include tests for require-system

Based on a contribution by Daniel Kochmanski in gitlab MR !13.
parent 0e27f08f
(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"))
......@@ -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)
......@@ -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
......
;; -*- 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")))
Please register or sign in to reply
(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")
  • This generates an error:

    TEST ABORTED: The value "require-system/ordinary" is not of type ASDF/COMPONENT:COMPONENT
    Edited by Elias Pipping
  • Uh? Did you get commit 0e27f08f ? It modifies mark-component-preloaded to accept component designators.

  • (Works for me.)

  • git checkout 3.1.7.23; git clean -fdx; make test-lisp l=sbcl SBCL=sbcl-1.3.9 t=test-require.script

    ...

    TEST ABORTED: The value
                    "require-system/ordinary"
                  is not of type
                    ASDF/COMPONENT:COMPONENT

    I'm not making this up.

  • 1- Are you sure you do not have local changes to operate.lisp? as in git reset --hard

    2- Can you provide a backtrace from sbcl?

  • 3- and if problem persists, also (trace find-component mark-component-preloaded) just before the fail point.

    Edited by Francois-Rene Rideau
  • In your snippets, mark-component-preloaded is called, but doesn't itself call find-component. What's happening??? Can you use (uiop-debug) and wrap the call to (find-component ...) in a (DBG :blah (find-component ...)) ??

    I can vaguely imagine function upgrade issues since the signature of find-component is changing, but you're not even upgrading asdf, are you?

  • Can you confirm that the last function in operate.lisp is mark-component-preloaded and starts with (let ((component (find-component component nil :registered t))) ?

  • Yes. Please see the error and tail -n10 operate.lisp here: https://gitlab.common-lisp.net/snippets/11

  • I don't think I'm upgrading asdf.

  • Could you show me a diff of what changes exactly I should be carrying out in order to debug this?

  • Your snippet says ga1aa0b12, but I see no such version in the master log. Can you rebase and send me a diff from master?

    My debug diff:

    diff --git a/operate.lisp b/operate.lisp
    index 86b6865..30c7482 100644
    --- a/operate.lisp
    +++ b/operate.lisp
    @@ -257,9 +257,10 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
     
       ;; The following function's symbol is from asdf/find-system.
       ;; It is defined here to resolve what would otherwise be forward package references.
    +  (uiop-debug)
       (defun mark-component-preloaded (component)
         "Mark a component as preloaded."
    -    (let ((component (find-component component nil :registered t)))
    +    (let ((component (DBG :mcp (find-component component nil :registered t))))
           ;; Recurse to children, so asdf/plan will hopefully be happy.
           (map () 'mark-component-preloaded (component-children component))
           ;; Mark the timestamps of the common lisp-action operations as 0.
    Edited by Elias Pipping
  • It's because git describe adds a 'g' to the front of the revision.

  • How the hell could that function fail without printing an according MCP debug statement? And why for you and not for me? Can you add DBG statements until you pinpoint where in the function the failure happens?

  • And why only with this system? Does it succeed, or fail more interestingly, with ccl or clisp?

  • it fails with ecl, sbcl, cmucl. It passes with ccl, lispworks, allegro cl.

    mkcl fails the test, too, but earlier.

    please see also the overview and full log archive.

    Edited by Elias Pipping
  • The issue does not seem to be related to optimisation since

    --- a/test/script-support.lisp
    +++ b/test/script-support.lisp
    @@ -38,7 +38,7 @@ Some constraints:
     
     #+(and ecl (not ecl-bytecmp)) (require :cmp)
     
    -(declaim (optimize (speed 2) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
    +(declaim (optimize (speed 0) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
                        #+(or cmucl scl) (c::brevity 2)))
     (proclaim '(optimize (speed #-gcl 2 #+gcl 1) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
                          #+(or cmucl scl) (c::brevity 2) #+(or cmucl scl) (ext:inhibit-warnings 3)))

    doesn't help.

    I'm doing all my testing on a machine in the cloud; I could give you SSH access if you want. All I need is a public key.

    Edited by Elias Pipping
  • Found it!

    1- I was not seeing it, because I am an idiot and was NOT using sbcl when I thought I was.

    2- The error is that sbcl takes the (declaim (ftype ...)) seriously, and I failed to modify the declared argument type from component to t after I loosened the convention to allow a component designator rather than a component.

  • Yay. I was about to lose my mind over this. While we're at it: Do you happen to know how I'd print a list of all defmethods by a certain name, with their signature?

  • It's worth noting that even with this issue out of the way, the test does not pass. I'll run tests overnight to check what exactly fails (it appears to be different for each lisp)

  • Fixed in !20 (closed) --- please review.

Please register or sign in to reply
(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
Please register or sign in to reply
;;; 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))
  • I'm not sure I understand this part of the test. A look at the log will tell you that clisp does not have a zlib module for me. By which I mean: when I start my repl it's not loaded, but it also cannot be loaded. My understanding is that this test wants a module which can be loaded but isn't by default. I'm not sure if such a thing exists for clisp. I've looked at the lisp of modules for clisp. Each one has a corresponding entry in *features*. The list of require-able modules is:

    (list #+berkeley-db "bdb"
          #+dirkey "ldap"
          #+fastcgi "fastcgi"
          #+i18n "i18n"
          #+matlab "matlab" ;; case-sensitive                                        
          #+netica "netica" ;; case-sensitive                                        
          #+oracle "oracle"
          #+pari "pari" ;; case-sensitive                                            
          #+pcre "pcre"
          #+postgresql "sql" ;; case-sensitive                                       
          #+rawsock "rawsock"
          #+regexp "regexp"
          #+syscalls "posix"
          #+wildcard "wildcard"
          #+zlib "zlib")

    For me, that list is identical with *modules* which I take to mean that all the require-able modules are already loaded. Indeed, "regexp" is in both lists and using that yields

    TEST ABORTED: (NOT (HAS-MODULE-P *MOD*))

    So we might just have to skip this part of the test on clisp.

  • What about "clx"? Is it always a module? Is anything always a module?

  • I've left a comment on !20 (closed): My clisp-hg/lib/clisp-2.49+/dynmod is empty. Apparently, not a single non-base module is guaranteed to exist.

Please register or sign in to reply
(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*))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment