Merge branch 'iss124-test' into 'master'

Test for issue 124.

See merge request asdf/asdf!212

Author: rpgoldman

test/poor-package-control.script

@@ -0,0 +1,28 @@
+;;; -*- Mode: common-lisp; -*-
+
+;;; Test for cl.net gitlab issue #124
+;;; If *PACKAGE* is bound to the package named foobar in the context in which
+;;; file1.lisp is compiled, that will cause an error (defpackage not found).
+
+;;; ABCL does not issue the errors we expect.
+(when (member :abcl *features*)
+  (leave-test "This test does not function properly on ABCL." 0))
+
+(defpackage foobar
+  (:use))
+
+(def-test-system test-bad-package-discipline
+  :components ((:file "file1")))
+
+(setf asdf:*compile-file-warnings-behaviour* :error
+      asdf:*compile-file-failure-behaviour* :error)
+
+(with-expected-failure ("Value of *PACKAGE* not controlled")
+  (let ((*package* (find-package :foobar))
+          (asdf:*compile-file-warnings-behaviour* :error))
+      (asdf:compile-system "test-bad-package-discipline" :force t)))
+
+(with-expected-failure ("Value of *PACKAGE* not controlled")
+  (in-package :foobar)
+  (cl:let ((asdf:*compile-file-warnings-behaviour* :error))
+    (asdf:compile-system "test-bad-package-discipline" :force cl:t)))

test/script-support.lisp

@@ -632,7 +632,15 @@ is bound, write a message and exit on an error.  If
            `(:output-translations
              (,(acall :wilden *asdf-directory*) ,(acall :wilden (resolve-output "asdf/")))
              (t ,(acall :wilden (resolve-output "root")))
-             :ignore-inherited-configuration)))
+             :ignore-inherited-configuration))
+
+    (let ((fasl-dir (resolve-output "asdf/test/")))
+      (when (acall (list '#:directory-exists-p :uiop) fasl-dir)
+        (format t "Removing old fasls from directory ~a.~%" fasl-dir)
+        (funcall (asym '#:delete-directory-tree :uiop t)
+                 fasl-dir
+                 :validate #'(lambda (x)
+                               (member "build" (pathname-directory x) :test 'equal))))))
   (when (asym :*central-registry*)
     (set (asym :*central-registry*) `(,*test-directory*)))
   (format t "Being a bit verbose~%")