From ff9e3cb3f5ac725be40e7c957e10f56c8ebe6b97 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Wed, 2 Jan 2013 22:50:01 -0500
Subject: [PATCH] 2.26.49: Debug GCL 2.6 support, fix tests to work with its
 limitations.

Remove debugging code from previous commit.
---
 asdf.asd                              |  2 +-
 asdf.lisp                             | 61 +++++++++--------------
 test/script-support.lisp              |  8 ++--
 test/test-bundle.script               |  2 +-
 test/test-compile-file-failure.script |  4 +-
 test/test-configuration.script        |  7 +--
 test/test-module-pathnames.script     | 69 +++++++++++----------------
 test/test-multiple.script             | 11 ++---
 test/test-system-pathnames.script     | 54 +++++++--------------
 test/test-try-recompiling-1.script    |  6 +--
 test/test-xach-update-bug.script      | 21 ++++----
 test/xach-foo-1/a.lisp                |  4 +-
 test/xach-foo-2/a.lisp                |  4 +-
 test/xach-foo-2/b.lisp                |  2 +-
 14 files changed, 97 insertions(+), 158 deletions(-)

diff --git a/asdf.asd b/asdf.asd
index 75811dd2..dcedcc7a 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -14,7 +14,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.48" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.49" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components
   ((:file "asdf")))
diff --git a/asdf.lisp b/asdf.lisp
index d92e9660..fddcd9a9 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.48: Another System Definition Facility.
+;;; This is ASDF 2.26.49: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
@@ -79,7 +79,8 @@
     (make-package :asdf :use '(:common-lisp))))
 
 #+gcl (defpackage :asdf (:use :cl) ;; GCL treats defpackage magically and needs this
-        #+gcl<2.7 (:shadowing-import-from :system :*load-pathname*))
+        #+gcl<2.7 (:shadowing-import-from :system :*load-pathname*) ;; GCL 2.6 sucks
+        #+gcl<2.7 (:shadow :type-of))
 
 (in-package :asdf)
 
@@ -119,7 +120,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.26.48")
+         (asdf-version "2.26.49")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -494,7 +495,7 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.")
     (fs:create-directories-recursively (pathname path))))
 
 #+gcl<2.7
-(progn
+(progn ;; Doesn't support either logical-pathnames or output-translations.
   (deftype logical-pathname () nil)
   (defun wild-pathname-p (path) (declare (ignore path)) nil)
   (defun translate-logical-pathname (x) x)
@@ -503,8 +504,9 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.")
     (declare (ignore in-wildname wild-wildname)) nil)
   (defun translate-pathname (source from-wildname to-wildname &key)
     (declare (ignore from-wildname to-wildname)) source)
+  (defun type-of (x) (class-name (class-of x)))
   (defun %print-unreadable-object (object stream type identity thunk)
-    (format stream "<~@[~S ~] " (when type (class-name (class-of object))))
+    (format stream "#<~@[~S ~]" (when type (type-of object)))
     (funcall thunk)
     (format stream "~@[ ~X~]>" (when identity (system:address object))))
   (defmacro with-compilation-unit (options &body body)
@@ -517,22 +519,6 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.")
 ;;;; -------------------------------------------------------------------------
 ;;;; General Purpose Utilities
 
-(defmacro DBG (tag &rest exprs)
-  "simple debug statement macro:
-outputs a tag plus a list of variable and their values, returns the last value"
-  ;"if not in debugging mode, just compute and return last value"
-  ; #-do-test (declare (ignore tag)) #-do-test (car (last exprs)) #+do-test
-  (let ((res (gensym))(f (gensym)))
-  `(let (,res (*print-readably* nil))
-    (flet ((,f (fmt &rest args) (apply #'format *error-output* fmt args)))
-      (,f "~&~A~%" ,tag)
-      ,@(mapcan
-         #'(lambda (x)
-            `((,f "~&  ~S => " ',x)
-              (,f "~{~S~^ ~}~%" (setf ,res (multiple-value-list ,x)))))
-         exprs)
-      (apply 'values ,res)))))
-
 (macrolet
     ((defdef (def* def)
        `(defmacro ,def* (name formals &rest rest)
@@ -577,18 +563,19 @@ and NIL NAME, TYPE and VERSION components"
 
 (defun* normalize-pathname-directory-component (directory)
   "Given a pathname directory component, return an equivalent form that is a list"
+  #+gcl<2.7 (setf directory (substitute :back :parent directory))
   (cond
     #-(or cmu sbcl scl) ;; these implementations already normalize directory components.
     ((stringp directory) `(:absolute ,directory))
     #+gcl<2.7
-    ((and (consp directory) (stringp (first directory)))
-     `(:relative ,@directory))
-    #+gcl<2.7
     ((and (consp directory) (eq :root (first directory)))
      `(:absolute ,@(rest directory)))
     ((or (null directory)
          (and (consp directory) (member (first directory) '(:absolute :relative))))
      directory)
+    #+gcl<2.7
+    ((consp directory)
+     `(:relative ,@directory))
     (t
      (error (compatfmt "~@<Unrecognized pathname directory component ~S~@:>") directory))))
 
@@ -623,16 +610,15 @@ and NIL NAME, TYPE and VERSION components"
     #+clisp (cons (mapcar 'make-pathname-component-logical x))
     (t x)))
 
-(defun* denormalize-pathname-directory-component (directory)
-  #-gcl<2.7 directory
+(defun* denormalize-pathname-directory-component (directory-component)
+  #-gcl<2.7 directory-component
   #+gcl<2.7
-  (cond
-    ((and (consp directory) (eq :relative (first directory)))
-     (rest directory))
-    ((and (consp directory) (eq :absolute (first directory)))
-     `(:root ,@(rest directory)))
-    (t
-     directory)))
+  (let ((d (substitute-if :parent (lambda (x) (member x '(:up :back)))
+                          directory-component)))
+    (cond
+      ((and (consp d) (eq :relative (first d))) (rest d))
+      ((and (consp d) (eq :absolute (first d))) `(:root ,@(rest d)))
+      (t d))))
 
 (defun* make-pathname* (&key host device directory name type version defaults)
   (make-pathname
@@ -2171,7 +2157,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
       (format stream "~{~S~^ ~}" (operation-original-initargs o)))))
 
 (defun* node-for (o c)
-  (cons (class-name (class-of o)) c))
+  (cons (type-of o) c))
 
 (defmethod operation-ancestor ((o operation))
   (aif (operation-parent o)
@@ -2436,7 +2422,6 @@ If true, an integer indexing the action in the list of actions planned."))
             (operation-description o c)
             missing-in (length missing-in) (and missing-in missing-out)
             missing-out (length missing-out)))
-;;(DBG :cas o c just-done plan stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c))
     ;; Note that we use stamp<= instead of stamp< to play nice with generated files.
     ;; Any race condition is intrinsic to the limited timestamp resolution.
     (if (or just-done ;; The done-stamp is valid: if we're just done, or
@@ -2484,7 +2469,6 @@ If true, an integer indexing the action in the list of actions planned."))
 
 (defmethod traverse-action (plan operation component needed-in-image-p)
   (block nil
-    ;;(DBG :ta operation component needed-in-image-p (plan-visiting-action-list plan))
     (unless (action-valid-p operation component) (return nil))
     (plan-record-dependency plan operation component)
     (let* ((aniip (needed-in-image-p operation component))
@@ -2492,7 +2476,6 @@ If true, an integer indexing the action in the list of actions planned."))
            (status (plan-action-status plan operation component)))
       (when (and status (or (action-done-p status) (action-planned-p status) (not eniip)))
         ;; Already visited with sufficient need-in-image level: just return the stamp.
-        ;;(DBG :ad status eniip aniip)
         (return (action-stamp status)))
       (labels ((visit-action (niip)
                  (visit-dependencies operation component
@@ -2500,7 +2483,6 @@ If true, an integer indexing the action in the list of actions planned."))
                  (multiple-value-bind (stamp done-p)
                      (compute-action-stamp operation component :plan plan)
                    (let ((add-to-plan-p (or (eql stamp t) (and niip (not done-p)))))
-                     ;;(DBG :va operation component needed-in-image-p niip aniip eniip done-p stamp add-to-plan-p)
                      (cond
                        ((and add-to-plan-p (not niip)) ;; if we need to do it,
                         (visit-action t)) ;; then we need to do it in the image!
@@ -2745,7 +2727,8 @@ If true, an integer indexing the action in the list of actions planned."))
 (defmethod perform ((o load-source-op) (c cl-source-file))
   (declare (ignorable o))
   (call-with-around-compile-hook
-   c #'(lambda () (load (component-pathname c) :external-format (component-external-format c)))))
+   c #'(lambda () (load (component-pathname c)
+                        #-gcl<2.7 :external-format #-gcl<2.7 (component-external-format c)))))
 
 (defmethod perform ((o load-source-op) (c static-file))
   (declare (ignorable o c))
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 84b43564..1a3fc447 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -51,14 +51,14 @@
                     #+scl :scl
                     #+xcl :xcl))))
      (merge-pathnames
-      (make-pathname :directory `(#-gcl :relative "tmp" "fasls" ,impl)
+      (make-pathname :directory `(#-gcl<2.7 :relative "tmp" "fasls" ,impl)
                      :defaults *asdf-directory*)
       *asdf-lisp*))))
 
 (defun load-old-asdf (tag)
   (let ((old-asdf
           (merge-pathnames
-           (make-pathname :directory `(#-gcl :relative "tmp")
+           (make-pathname :directory `(#-gcl<2.7 :relative "tmp")
                           :name (format nil "asdf-~A" tag)
                           :defaults *asdf-directory*)
            *asdf-lisp*)))
@@ -74,7 +74,7 @@
 (defun load-asdf ()
   (load *asdf-fasl*)
   (use-package :asdf :asdf-test)
-  ;;(import 'DBG :asdf)
+  (import 'DBG :asdf)
   (configure-asdf)
   (setf *package* (find-package :asdf-test)))
 
@@ -262,5 +262,5 @@ outputs a tag plus a list of variable and their values, returns the last value"
 
 
 #|
-(DBG :cas o c just-done base-stamp stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c))
+(DBG :cas o c just-done plan stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c))
 |#
diff --git a/test/test-bundle.script b/test/test-bundle.script
index 3637e541..9fe49617 100644
--- a/test/test-bundle.script
+++ b/test/test-bundle.script
@@ -14,7 +14,7 @@
  (when (find-package :test-package) (delete-package :test-package))
  (asdf:defsystem :test-bundle-1 :components ((:file "file1") (:file "file3")))
  (asdf:defsystem :test-bundle-2 :depends-on (:test-bundle-1) :components ((:file "file2")))
- #-(or abcl (and ecl ecl-bytecmp))
+ #-(or abcl (and ecl ecl-bytecmp) gcl)
  (let* ((op (make-instance 'asdf::fasl-op))
         (bundle-1 (asdf:output-file op (find-system :test-bundle-1)))
         (bundle-2 (asdf:output-file op (find-system :test-bundle-2))))
diff --git a/test/test-compile-file-failure.script b/test/test-compile-file-failure.script
index 91a74415..85792e85 100644
--- a/test/test-compile-file-failure.script
+++ b/test/test-compile-file-failure.script
@@ -1,15 +1,15 @@
 ;;; -*- Lisp -*-
-
 (load "script-support.lisp")
 (load-asdf)
 
 (quit-on-error
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
+ #-gcl<2.7
  (assert (handler-case
              (let ((asdf:*compile-file-failure-behaviour* :warn))
                (asdf:load-system 'test-compile-file-failure :force t)
                t)
            (asdf:compile-error () nil)))
+ #-gcl<2.7
  (assert (handler-case
              (let ((asdf:*compile-file-failure-behaviour* :error))
                (asdf:load-system 'test-compile-file-failure :force t)
diff --git a/test/test-configuration.script b/test/test-configuration.script
index 90421e01..9654d35a 100644
--- a/test/test-configuration.script
+++ b/test/test-configuration.script
@@ -3,14 +3,11 @@
 (load-asdf)
 
 (in-package :asdf)
-
 (use-package :asdf-test)
-
-(defparameter *test-directory*
-  (merge-pathnames* (coerce-pathname "tmp/") *asdf-directory*))
+#+gcl<2.7 (defmacro with-standard-io-syntax (&body body) `(progn ,@body))
 
 (defun under-test-directory (designator &optional (defaults *test-directory*))
-  (namestring (merge-pathnames* (coerce-pathname designator) defaults)))
+  (namestring (subpathname defaults designator)))
 
 (defun create-conf-files (&optional (path *test-directory*))
   (let ((v `(("conf.d/conf1.conf"
diff --git a/test/test-module-pathnames.script b/test/test-module-pathnames.script
index af5e93cb..8d23240e 100644
--- a/test/test-module-pathnames.script
+++ b/test/test-module-pathnames.script
@@ -3,25 +3,16 @@
 (load-asdf)
 
 (quit-on-error
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (asdf:load-system 'test-module-pathnames)
- (flet ((submodule (module name)
-          (find name (asdf:module-components module)
-                :key #'asdf:component-name :test #'equal))
-        (pathname-foo (x)
-          (list (pathname-directory x) (pathname-name x) (pathname-type x))))
-   (let* ((system (asdf:find-system "test-module-pathnames"))
-          (level1 (submodule system "sources/level1"))
-          (static (submodule level1 "level2/static.file"))
-          (test-tmp (submodule level1 "test-tmp.cl")))
-     (assert (member (pathname-foo (asdf:component-relative-pathname test-tmp))
-                     '(((:relative) "test-tmp" "cl")
-                       (nil "test-tmp" "cl")) :test 'equal)
-             () "Didn't get the name of test-tmp.cl right")
-     (assert (equal
-              (pathname-foo (asdf:component-relative-pathname static))
-              '((:relative "level2") "static" "file"))
-             () "Didn't get the name of static.file right")))
+ (flet ((pathname-foo (x)
+          (list (or (asdf::normalize-pathname-directory-component (pathname-directory x)) '(:relative))
+                (pathname-name x) (pathname-type x))))
+   (let* ((static (find-component "test-module-pathnames" '("sources/level1" "level2/static.file")))
+          (test-tmp (find-component "test-module-pathnames" '("sources/level1" "test-tmp.cl"))))
+     (assert-equal (pathname-foo (asdf:component-relative-pathname test-tmp))
+                   '((:relative) "test-tmp" "cl"))
+     (assert-equal (pathname-foo (asdf:component-relative-pathname static))
+                   '((:relative "level2") "static" "file"))))
  (assert (find-package :test-package)
          () "package test-package not found")
  (assert (find-symbol (symbol-name '*file-tmp*) :test-package)
@@ -29,28 +20,26 @@
  (assert (symbol-value (find-symbol (symbol-name '*file-tmp*) :test-package))
          () "symbol `*file-tmp*` has wrong value")
 
-#| ; must be adapted to ABL
- (assert (probe-file (merge-pathnames
-                      (make-pathname
-                       :name "file1"
-                       :type (pathname-type (compile-file-pathname "x"))
-                       :directory '(:relative "sources" "level1"))))
-         nil "compiled file not found")
-|#
+ (assert (probe-file
+          (asdf::apply-output-translations
+           (asdf::merge-pathnames*
+            (asdf::make-pathname*
+             :name "file1"
+             :type (asdf::fasl-type)
+             :directory '(:relative "sources" "level1"))
+            *test-directory*)))
+         () "compiled file not found")
 
- (assert (find-symbol (symbol-name '*file-tmp2*) :test-package) nil
-         "symbol `*file-tmp2*` not found")
+ (assert (find-symbol (symbol-name '*file-tmp2*) :test-package)
+         () "symbol `*file-tmp2*` not found")
  (assert (symbol-value (find-symbol (symbol-name '*file-tmp2*) :test-package))
-         nil "symbol `*file-tmp2*` has wrong value")
+         () "symbol `*file-tmp2*` has wrong value")
 
-#| ; must be adapted to ABL
-
- (assert (probe-file (merge-pathnames
-                      (make-pathname
-                       :name "file2"
-                       :type (pathname-type (compile-file-pathname "x"))
-                       :directory '(:relative "sources" "level1" "level2"))))
-         nil "compiled file not found")
-|#
-
-)
+ (assert (probe-file
+          (asdf::apply-output-translations
+           (asdf::merge-pathnames*
+            (asdf::make-pathname*
+             :name "file2"
+             :type (asdf::fasl-type)
+             :directory '(:relative "sources" "level1" "level2")))))
+         nil "compiled file not found"))
diff --git a/test/test-multiple.script b/test/test-multiple.script
index 7a9ecc2c..2eeafa6a 100644
--- a/test/test-multiple.script
+++ b/test/test-multiple.script
@@ -6,14 +6,11 @@
 (use-package :asdf-test)
 
 (quit-on-error
- (let* ((asd (merge-pathnames* (coerce-pathname "test-multiple.asd")
-                               *test-directory*))
-        (tmp (merge-pathnames* (coerce-pathname "../tmp/")
-                               *test-directory*))
-        (asd2 (merge-pathnames* (coerce-pathname "test-multiple-too.asd")
-                                     tmp))
+ (let* ((asd (subpathname *test-directory* "test-multiple.asd"))
+        (tmp (subpathname *test-directory* "../tmp/"))
+        (asd2 (subpathname tmp "test-multiple-too.asd"))
         (file4 (compile-file-pathname* "file4")))
-   (setf *central-registry* `(*default-pathname-defaults* ,tmp))
+   (setf *central-registry* `(,*test-directory* ,tmp))
    (assert (= 0 (run-shell-command
                  (format nil "/bin/ln -sf ~A ~A"
                          (native-namestring asd)
diff --git a/test/test-system-pathnames.script b/test/test-system-pathnames.script
index 3422bd50..4d661814 100644
--- a/test/test-system-pathnames.script
+++ b/test/test-system-pathnames.script
@@ -3,25 +3,7 @@
 (load-asdf)
 
 (quit-on-error
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (asdf:load-system 'test-system-pathnames)
- (flet ((submodule (module name)
-          (find name (asdf:module-components module)
-                :key #'asdf:component-name :test #'equal))
-        (pathname-foo (x)
-          (list (pathname-directory x) (pathname-name x) (pathname-type x))))
-   (let* ((system (asdf:find-system "test-module-pathnames"))
-          (level1 (submodule system "sources/level1"))
-          (static (submodule level1 "level2/static.file"))
-          (test-tmp (submodule level1 "test-tmp.cl")))
-     (assert (member (pathname-foo (asdf:component-relative-pathname test-tmp))
-                     '(((:relative) "test-tmp" "cl")
-                       (nil "test-tmp" "cl")) :test 'equal)
-             () "Didn't get the name of test-tmp.cl right")
-     (assert (equal
-              (pathname-foo (asdf:component-relative-pathname static))
-              '((:relative "level2") "static" "file"))
-             () "Didn't get the name of static.file right")))
  (assert (find-package :test-package)
          () "package test-package not found")
  (assert (find-symbol (symbol-name '*file-tmp*) :test-package)
@@ -29,28 +11,26 @@
  (assert (symbol-value (find-symbol (symbol-name '*file-tmp*) :test-package))
          () "symbol `*file-tmp*` has wrong value")
 
-#| ; must be adapted to ABL
- (assert (probe-file (merge-pathnames
-                      (make-pathname
-                       :name "file1"
-                       :type (pathname-type (compile-file-pathname "x"))
-                       :directory '(:relative "sources" "level1"))))
-         nil "compiled file not found")
-|#
+ (assert (probe-file
+          (asdf::apply-output-translations
+           (asdf::merge-pathnames*
+            (asdf::make-pathname*
+             :name "file1"
+             :type (asdf::fasl-type)
+             :directory '(:relative "sources" "level1"))
+            *test-directory*)))
+         () "compiled file not found")
 
  (assert (find-symbol (symbol-name '*file-tmp2*) :test-package) nil
          "symbol `*file-tmp2*` not found")
  (assert (symbol-value (find-symbol (symbol-name '*file-tmp2*) :test-package))
          nil "symbol `*file-tmp2*` has wrong value")
 
-#| ; must be adapted to ABL
-
- (assert (probe-file (merge-pathnames
-                      (make-pathname
-                       :name "file2"
-                       :type (pathname-type (compile-file-pathname "x"))
-                       :directory '(:relative "sources" "level1" "level2"))))
-         nil "compiled file not found")
-|#
-
-)
+ (assert (probe-file
+          (asdf::apply-output-translations
+           (asdf::merge-pathnames*
+            (asdf::make-pathname*
+             :name "file2"
+             :type (asdf::fasl-type)
+             :directory '(:relative "sources" "level1" "level2")))))
+         nil "compiled file not found"))
diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script
index 79efdc2d..0b15456b 100644
--- a/test/test-try-recompiling-1.script
+++ b/test/test-try-recompiling-1.script
@@ -7,10 +7,7 @@
 (defvar *caught-error* nil)
 
 (quit-on-error
- (run-shell-command "rm -f ~A"
-                    (namestring
-                     (compile-file-pathname "try-recompiling-1")))
- (setf *central-registry* '(*default-pathname-defaults*))
+ (asdf::delete-file-if-exists (compile-file-pathname "try-recompiling-1"))
  #-gcl
  (handler-bind ((error (lambda (c)
                          (setf *caught-error* t)
@@ -26,4 +23,5 @@
                              (when restart
                                (invoke-restart restart)))))))
    (oos 'load-op 'try-recompiling-1))
+ #-gcl
  (assert *caught-error*))
diff --git a/test/test-xach-update-bug.script b/test/test-xach-update-bug.script
index d9bacb17..eb40cba7 100644
--- a/test/test-xach-update-bug.script
+++ b/test/test-xach-update-bug.script
@@ -2,17 +2,12 @@
 (load "script-support.lisp")
 (load-asdf)
 
+#+gcl (trace load compile-file asdf:perform asdf::perform-plan)
 (quit-on-error
- (let ((*default-pathname-defaults* (make-pathname :name nil
-                                                   :type nil
-                                                   :defaults *load-truename*)))
-   (setf asdf:*central-registry* nil)
-   (push (merge-pathnames #p"xach-foo-1/") asdf:*central-registry*)
-   (asdf:load-system "foo")
-   (assert (symbol-value (find-symbol (string :loaded) :first-version)))
-   (push (merge-pathnames #p"xach-foo-2/") asdf:*central-registry*)
-   (asdf:load-system "foo")
-   (assert (symbol-value (find-symbol (string :loaded) :second-version)))
-   (assert (eql 42 (funcall (find-symbol (string :wtf) :second-version))))))
-
-
+ (setf asdf:*central-registry* (list (asdf::subpathname *test-directory* "xach-foo-1/")))
+ (asdf:load-system "foo")
+ (assert (symbol-value (find-symbol (string :loaded) :first-version)))
+ (setf asdf:*central-registry* (list (asdf::subpathname *test-directory* "xach-foo-2/")))
+ (asdf:load-system "foo")
+ (assert (symbol-value (find-symbol (string :loaded) :second-version)))
+ (assert (eql 42 (funcall (find-symbol (string :wtf) :second-version)))))
diff --git a/test/xach-foo-1/a.lisp b/test/xach-foo-1/a.lisp
index 126cae5a..94c0bddc 100644
--- a/test/xach-foo-1/a.lisp
+++ b/test/xach-foo-1/a.lisp
@@ -1,9 +1,9 @@
 ;;;; a.lisp
 
-(defpackage #:first-version
+(defpackage :first-version
   (:use #:cl)
   (:export #:loaded))
 
-(in-package #:first-version)
+(in-package :first-version)
 (defparameter loaded t)
 
diff --git a/test/xach-foo-2/a.lisp b/test/xach-foo-2/a.lisp
index b517d778..d8dee0d7 100644
--- a/test/xach-foo-2/a.lisp
+++ b/test/xach-foo-2/a.lisp
@@ -1,10 +1,10 @@
 ;;;; a.lisp
 
-(defpackage #:second-version
+(defpackage :second-version
   (:use #:cl)
   (:export #:loaded #:wtf))
 
-(in-package #:second-version)
+(in-package :second-version)
 
 (defparameter loaded t)
 
diff --git a/test/xach-foo-2/b.lisp b/test/xach-foo-2/b.lisp
index dda671b5..0b82a074 100644
--- a/test/xach-foo-2/b.lisp
+++ b/test/xach-foo-2/b.lisp
@@ -1,6 +1,6 @@
 ;;;; b.lisp
 
-(in-package #:second-version)
+(in-package :second-version)
 
 (defun wtf ()
   42)
-- 
GitLab