diff --git a/Makefile b/Makefile
index bbabf056f66cd33ce34c704bf4304881bbb5ab3f..8ba0d4c5577fee37c2a965390b96c07d07474600 100644
--- a/Makefile
+++ b/Makefile
@@ -11,6 +11,7 @@ lisps ?= ccl clisp sbcl ecl ecl_bytecodes cmucl abcl scl allegro lispworks alleg
 endif
 
 export ASDF_OUTPUT_TRANSLATIONS := (:output-translations (t ("${sourceDirectory}/tmp/fasls" :implementation)) :ignore-inherited-configuration)
+export CL_SOURCE_REGISTRY := (:source-registry (:tree "${sourceDirectory}") :ignore-inherited-configuration)
 
 ## MAJOR FAIL: gclcvs -- COMPILER BUG! Upstream fixed it, but upstream fails to compile.
 ## NOT SUPPORTED BY OUR TESTS: cormancl genera lispworks-personal-edition mkcl rmcl. Manually tested once in a while.
@@ -29,6 +30,7 @@ SCL ?= scl
 ALLEGRO ?= alisp
 ALLEGROMODERN ?= mlisp
 LISPWORKS ?= lispworks
+GCL ?= gcl
 
 # website, tag, install
 
@@ -98,6 +100,7 @@ test-upgrade:
 	use_abcl () { li="${ABCL} --noinit --nosystem --noinform" ; ev="--eval" ; } ; \
 	use_xcl () { li="${XCL} --noinit --nosystem --noinform" ; ev="--eval" ; } ; \
 	use_scl () { li="${SCL} -noinit" ; ev="-eval" ; } ; \
+	use_gcl () { li="GCL_ANSI=t ${GCL}" ; ev="-eval" ; } ; \
 	use_allegro () { li="${ALLEGRO} -q" ; ev="-e" ; } ; \
 	use_allegromodern () { li="${ALLEGROMODERN} -q" ; ev="-e" ; } ; \
 	use_lispworks () { li="${LISPWORKS} -siteinit - -init -" ; ev="-eval" ; } ; \
diff --git a/asdf.asd b/asdf.asd
index 4627647a6b033da4797250fcc9edf9b28f998b30..75811dd29f7bc1bf5f5cd72b9c743039f48307f3 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.47" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.48" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components
   ((:file "asdf")))
diff --git a/asdf.lisp b/asdf.lisp
index c59ad3aaca5ceb30ec773b2065dd268244c082c3..d92e96604d5437b4d53955ad82f71914a865f71a 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.47: Another System Definition Facility.
+;;; This is ASDF 2.26.48: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
@@ -57,8 +57,6 @@
 ;;;; See https://bugs.launchpad.net/asdf/+bug/485687
 ;;;; See these two eval-when forms, and more near the end of the file.
 
-#+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
-
 (eval-when (:load-toplevel :compile-toplevel :execute)
   ;;; Before we do anything, some implementation-dependent tweaks
   ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; NO: trust implementation defaults.
@@ -70,7 +68,8 @@
   (when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all
             (and (= system::*gcl-major-version* 2)
                  (< system::*gcl-minor-version* 7)))
-    (pushnew :gcl-pre2.7 *features*))
+    (pushnew 'ignorable pcl::*variable-declarations-without-argument*)
+    (pushnew :gcl<2.7 *features*))
   #+(or abcl (and allegro ics) (and (or clisp cmu ecl mkcl) unicode)
         clozure lispworks (and sbcl sb-unicode) scl)
   (pushnew :asdf-unicode *features*)
@@ -79,6 +78,9 @@
   (unless (find-package :asdf)
     (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*))
+
 (in-package :asdf)
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
@@ -100,12 +102,11 @@
   (defun strcat (&rest strings)
     (apply 'concatenate 'string strings))
   (defmacro compatfmt (format)
-    #-(or gcl genera) format
     #+(or gcl genera)
     (loop :for (unsupported . replacement) :in
       (append
        '(("~3i~_" . ""))
-       #+genera '(("~@<" . "") ("; ~@;" . "; ") ("~@:>" . "") ("~:>" . ""))) :do
+       #+(or genera gcl<2.7) '(("~@<" . "") ("; ~@;" . "; ") ("~@:>" . "") ("~:>" . ""))) :do
       (loop :for found = (search unsupported format) :while found :do
         (setf format (strcat (subseq format 0 found) replacement
                              (subseq format (+ found (length unsupported)))))))
@@ -118,7 +119,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.47")
+         (asdf-version "2.26.48")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -233,18 +234,17 @@
            :use (:common-lisp)
            :redefined-functions
            (#:perform #:explain #:output-files #:operation-done-p #:do-traverse
-            #:visit-action #:compute-action-stamp #:component-load-dependencies #:traverse-action
+            #:compute-action-stamp #:component-load-dependencies #:traverse-action
             #:component-depends-on #:perform-plan #:mark-operation-done
             #:perform-with-restarts #:component-relative-pathname
             #:system-source-file #:operate #:find-component #:find-system
             #:apply-output-translations #:translate-pathname* #:resolve-location
-            #:system-relative-pathname #:source-file-type
-            #:component-visited-p #:builtin-system-p
+            #:system-relative-pathname #:source-file-type #:builtin-system-p
             #:inherit-source-registry #:process-source-registry #:process-source-registry-directive
             #:compile-file* #:source-file-type #:trivial-system-p)
            :unintern
            (#:*asdf-revision* #:around #:asdf-method-combination
-            #:split #:make-collector #:do-dep #:do-one-dep
+            #:split #:make-collector #:do-dep #:do-one-dep #:visit-action #:component-visited-p
             #:loaded-systems ; makes for annoying SLIME completion
             #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function
            :export
@@ -455,7 +455,7 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.")
                 condition-format condition-location
                 coerce-name)
          (ftype (function (&optional t) (values)) initialize-source-registry)
-         #-(or cormanlisp gcl-pre2.7)
+         #-(or cormanlisp gcl<2.7)
          (ftype (function (t t) t) (setf component-children-by-name)))
 
 ;;;; -------------------------------------------------------------------------
@@ -488,14 +488,58 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.")
                 (when (eq #$noerr (#_fspathmakeref cpath fsref is-dir))
                   (ccl::%path-from-fsref fsref is-dir))))))"))
 
+#+genera
+(unless (fboundp 'ensure-directories-exist)
+  (defun ensure-directories-exist (path)
+    (fs:create-directories-recursively (pathname path))))
+
+#+gcl<2.7
+(progn
+  (deftype logical-pathname () nil)
+  (defun wild-pathname-p (path) (declare (ignore path)) nil)
+  (defun translate-logical-pathname (x) x)
+  (defvar *compile-file-pathname* nil)
+  (defun pathname-match-p (in-pathname wild-pathname)
+    (declare (ignore in-wildname wild-wildname)) nil)
+  (defun translate-pathname (source from-wildname to-wildname &key)
+    (declare (ignore from-wildname to-wildname)) source)
+  (defun %print-unreadable-object (object stream type identity thunk)
+    (format stream "<~@[~S ~] " (when type (class-name (class-of object))))
+    (funcall thunk)
+    (format stream "~@[ ~X~]>" (when identity (system:address object))))
+  (defmacro with-compilation-unit (options &body body)
+    (declare (ignore options)) `(progn ,@body))
+  (defmacro print-unreadable-object ((object stream &key type identity) &body body)
+    `(%print-unreadable-object ,object ,stream ,type ,identity (lambda () ,@body)))
+  (defun ensure-directories-exist (path)
+    (run-shell-command "mkdir -p ~S" (namestring (pathname-directory-pathname path)))))
+
 ;;;; -------------------------------------------------------------------------
 ;;;; 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)
           `(progn
-             #+(or ecl (and gcl (not gcl-pre2.7))) (fmakunbound ',name)
+             #+(or ecl gcl)
+             ,(when (and #+gcl<2.7 (symbolp name))
+                `(fmakunbound ',name))
              #-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
              ,(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
                 `(declaim (notinline ,name)))
@@ -535,10 +579,13 @@ and NIL NAME, TYPE and VERSION components"
   "Given a pathname directory component, return an equivalent form that is a list"
   (cond
     #-(or cmu sbcl scl) ;; these implementations already normalize directory components.
-    ((stringp directory) `(:absolute ,directory) directory)
-    #+gcl
+    ((stringp directory) `(:absolute ,directory))
+    #+gcl<2.7
     ((and (consp directory) (stringp (first directory)))
-     `(:absolute ,@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)
@@ -576,10 +623,27 @@ 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
+  #+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)))
+
+(defun* make-pathname* (&key host device directory name type version defaults)
+  (make-pathname
+   :defaults defaults :host host :device device
+   :directory (denormalize-pathname-directory-component directory)
+   :name name :type type :version version))
+
 (defun* make-pathname-logical (pathname host)
   "Take a PATHNAME's directory, name, type and version components,
 and make a new pathname with corresponding components and specified logical HOST"
-  (make-pathname
+  (make-pathname*
    :host host
    :directory (make-pathname-component-logical (pathname-directory pathname))
    :name (make-pathname-component-logical (pathname-name pathname))
@@ -618,19 +682,19 @@ Also, if either argument is NIL, then the other argument is returned unmodified.
                      (pathname-device defaults)
                      (merge-pathname-directory-components directory (pathname-directory defaults))
                      (unspecific-handler defaults))))
-        (make-pathname :host host :device device :directory directory
-                       :name (funcall unspecific-handler name)
-                       :type (funcall unspecific-handler type)
-                       :version (funcall unspecific-handler version))))))
+        (make-pathname* :host host :device device :directory directory
+                        :name (funcall unspecific-handler name)
+                        :type (funcall unspecific-handler type)
+                        :version (funcall unspecific-handler version))))))
 
 (defun* pathname-parent-directory-pathname (pathname)
   "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
 and NIL NAME, TYPE and VERSION components"
   (when pathname
-    (make-pathname :name nil :type nil :version nil
-                   :directory (merge-pathname-directory-components
-                               '(:relative :back) (pathname-directory pathname))
-                   :defaults pathname)))
+    (make-pathname* :name nil :type nil :version nil
+                    :directory (merge-pathname-directory-components
+                                '(:relative :back) (pathname-directory pathname))
+                    :defaults pathname)))
 
 (define-modify-macro appendf (&rest args)
   append "Append onto list") ;; only to be used on short lists.
@@ -646,7 +710,7 @@ and NIL NAME, TYPE and VERSION components"
 
 
 (defun* asdf-message (format-string &rest format-args)
-  (declare (dynamic-extent format-args))
+  #-gcl<2.7 (declare (dynamic-extent format-args))
   (apply 'format *verbose-out* format-string format-args))
 
 (defun* split-string (string &key max (separator '(#\Space #\Tab)))
@@ -791,20 +855,16 @@ actually-existing directory."
    ((directory-pathname-p pathspec)
     pathspec)
    (t
-    (make-pathname :directory (append (or (pathname-directory pathspec)
-                                          (list :relative))
-                                      (list (file-namestring pathspec)))
-                   :name nil :type nil :version nil
-                   :defaults pathspec))))
-
-#+genera
-(unless (fboundp 'ensure-directories-exist)
-  (defun* ensure-directories-exist (path)
-    (fs:create-directories-recursively (pathname path))))
+    (make-pathname* :directory (append (or (normalize-pathname-directory-component
+                                            (pathname-directory pathspec))
+                                           (list :relative))
+                                       (list (file-namestring pathspec)))
+                    :name nil :type nil :version nil :defaults pathspec))))
 
 (defun* absolute-pathname-p (pathspec)
   (and (typep pathspec '(or pathname string))
-       (eq :absolute (car (pathname-directory (pathname pathspec))))))
+       (eq :absolute (car (normalize-pathname-directory-component
+                           (pathname-directory (pathname pathspec)))))))
 
 (defun* coerce-pathname (name &key type defaults)
   "coerce NAME into a PATHNAME.
@@ -839,7 +899,7 @@ Host, device and version components are taken from DEFAULTS."
               (values filename type))
              (t
               (split-name-type filename)))
-         (apply 'make-pathname :directory (cons relative path) :name name :type type
+         (apply 'make-pathname* :directory (cons relative path) :name name :type type
                 (when defaults `(:defaults ,defaults))))))))
 
 (defun* merge-component-name-type (name &key type defaults)
@@ -880,11 +940,11 @@ Host, device and version components are taken from DEFAULTS."
      :collect form)))
 
 (defun* pathname-root (pathname)
-  (make-pathname :directory '(:absolute)
-                 :name nil :type nil :version nil
-                 :defaults pathname ;; host device, and on scl, *some*
-                 ;; scheme-specific parts: port username password, not others:
-                 . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
+  (make-pathname* :directory '(:absolute)
+                  :name nil :type nil :version nil
+                  :defaults pathname ;; host device, and on scl, *some*
+                  ;; scheme-specific parts: port username password, not others:
+                  . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
 
 (defun* probe-file* (p)
   "when given a pathname P, probes the filesystem for a file or directory
@@ -897,6 +957,12 @@ with given pathname and if it exists return its truename."
                       '(probe-file p)
                       #+clisp (aif (find-symbol* '#:probe-pathname :ext)
                                    `(ignore-errors (,it p)))
+                      #+gcl<2.7
+                      '(or (probe-file p)
+                        (and (directory-pathname-p p)
+                         (ignore-errors
+                          (ensure-directory-pathname
+                           (truename (subpathname (ensure-directory-pathname p) "."))))))
                       '(ignore-errors (truename p)))))))
 
 (defun* truenamize (pathname &optional (defaults *default-pathname-defaults*))
@@ -916,11 +982,11 @@ with given pathname and if it exists return its truename."
         (unless sofar (return p))
         (flet ((solution (directories)
                  (merge-pathnames*
-                  (make-pathname :host nil :device nil
-                                 :directory `(:relative ,@directories)
-                                 :name (pathname-name p)
-                                 :type (pathname-type p)
-                                 :version (pathname-version p))
+                  (make-pathname* :host nil :device nil
+                                  :directory `(:relative ,@directories)
+                                  :name (pathname-name p)
+                                  :type (pathname-type p)
+                                  :version (pathname-version p))
                   sofar)))
           (loop :with directory = (normalize-pathname-directory-component
                                    (pathname-directory p))
@@ -928,7 +994,7 @@ with given pathname and if it exists return its truename."
             :for rest :on (cdr directory)
             :for more = (probe-file*
                          (merge-pathnames*
-                          (make-pathname :directory `(:relative ,component))
+                          (make-pathname* :directory `(:relative ,component))
                           sofar)) :do
             (if more
                 (setf sofar more)
@@ -962,14 +1028,16 @@ with given pathname and if it exists return its truename."
 (defun* lispize-pathname (input-file)
   (make-pathname :type "lisp" :defaults input-file))
 
-(defparameter *wild* #-cormanlisp :wild #+cormanlisp "*")
+(defparameter *wild* (or #+cormanlisp "*" :wild))
 (defparameter *wild-file*
-  (make-pathname :name *wild* :type *wild*
-                 :version (or #-(or abcl xcl) *wild*) :directory nil))
+  (make-pathname* :directory nil :name *wild* :type *wild*
+                  :version (or #-(or abcl xcl) *wild*)))
 (defparameter *wild-directory*
-  (make-pathname :directory `(:relative ,*wild*) :name nil :type nil :version nil))
+  (make-pathname* :directory `(:relative ,(or #+gcl<2.7 "*" *wild*))
+                  :name nil :type nil :version nil))
 (defparameter *wild-inferiors*
-  (make-pathname :directory '(:relative :wild-inferiors) :name nil :type nil :version nil))
+  (make-pathname* :directory `(:relative ,(or #+gcl<2.7 "**" :wild-inferiors))
+                  :name nil :type nil :version nil))
 (defparameter *wild-path*
   (merge-pathnames *wild-file* *wild-inferiors*))
 
@@ -978,7 +1046,7 @@ with given pathname and if it exists return its truename."
 
 #-scl
 (defun* directory-separator-for-host (&optional (pathname *default-pathname-defaults*))
-  (let ((foo (make-pathname :directory '(:absolute "FOO") :defaults pathname)))
+  (let ((foo (make-pathname* :directory '(:absolute "FOO") :defaults pathname)))
     (last-char (namestring foo))))
 
 #-scl
@@ -997,8 +1065,7 @@ with given pathname and if it exists return its truename."
         (component-name-to-pathname-components root-string :force-directory t)
       (declare (ignore relative filename))
       (let ((new-base
-             (make-pathname :defaults root
-                            :directory `(:absolute ,@path))))
+             (make-pathname* :defaults root :directory `(:absolute ,@path))))
         (translate-pathname absolute-pathname wild-root (wilden new-base))))))
 
 #+scl
@@ -1020,8 +1087,8 @@ with given pathname and if it exists return its truename."
           (when (specificp scheme)
             (setf prefix (strcat scheme prefix)))
           (assert (and directory (eq (first directory) :absolute)))
-          (make-pathname :directory `(:absolute ,prefix ,@(rest directory))
-                         :defaults pathname)))
+          (make-pathname* :directory `(:absolute ,prefix ,@(rest directory))
+                          :defaults pathname)))
     pathname)))
 
 (defun* add-pathname-suffix (pathname suffix)
@@ -1125,13 +1192,15 @@ another pathname in a degenerate way."))
 
 (defgeneric* component-property (component property))
 
+#-gcl<2.7
 (defgeneric* (setf component-property) (new-value component property))
 
 (defgeneric* component-external-format (component))
 
 (defgeneric* component-encoding (component))
 
-(eval-when (#-gcl :compile-toplevel :load-toplevel :execute)
+#-gcl<2.7
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defgeneric* (setf component-children-by-name) (new-value parent)))
 
 (defgeneric* version-satisfies (component version))
@@ -1664,7 +1733,8 @@ NB: ignores leading zeroes, and so doesn't distinguish between 2.003 and 2.3"
                          (buffer (make-array length)))
                     (read-sequence buffer s)
                     (map 'string #'code-char buffer)))))))
-      (end-of-file ()
+      (end-of-file (c)
+        (declare (ignore c))
         nil)))))
 
 ;;;; -------------------------------------------------------------------------
@@ -1888,7 +1958,7 @@ Going forward, we recommend new users should be using the source-registry.
                    (external-format (encoding-external-format (detect-encoding pathname))))
                (asdf-message (compatfmt "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%")
                              pathname package)
-               (load pathname :external-format external-format)))
+               (load pathname #-gcl<2.7 :external-format #-gcl<2.7 external-format)))
         (delete-package package)))))
 
 (defun* locate-system (name)
@@ -2096,9 +2166,9 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
    (parent :initform nil :initarg :parent :accessor operation-parent)))
 
 (defmethod print-object ((o operation) stream)
-  (print-unreadable-object (o stream :type t :identity t)
+  (print-unreadable-object (o stream :type t :identity nil)
     (ignore-errors
-      (prin1 (operation-original-initargs o) stream))))
+      (format stream "~{~S~^ ~}" (operation-original-initargs o)))))
 
 (defun* node-for (o c)
   (cons (class-name (class-of o)) c))
@@ -2226,13 +2296,13 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
                       (latest-stamp-f stamp (funcall fun dep-o dep-c))))
   stamp)
 
-(defgeneric needed-in-image-p (operation component)
-  (:method ((o operation) (c component))
-    ;; We presume that actions that modify the filesystem don't need be run
-    ;; in the current image if they have already been done in another,
-    ;; and can be run in another process (e.g. a fork),
-    ;; whereas those that don't are meant to side-effect the current image and can't.
-    (not (output-files o c))))
+(defgeneric* needed-in-image-p (operation component))
+(defmethod needed-in-image-p ((o operation) (c component))
+  ;; We presume that actions that modify the filesystem don't need be run
+  ;; in the current image if they have already been done in another,
+  ;; and can be run in another process (e.g. a fork),
+  ;; whereas those that don't are meant to side-effect the current image and can't.
+  (not (output-files o c)))
 
 (defvar *visit-count* 0) ; counter that allows to sort nodes from operation-visited-nodes
 
@@ -2286,6 +2356,11 @@ in some previous image, or T if it needs to be done.")
     :documentation "generalized boolean, true iff the action was already done (before any plan)."))
   (:documentation "Status of an action"))
 
+(defmethod print-object ((status action-status) stream)
+  (print-unreadable-object (status stream :type t)
+    (with-slots (stamp done-p) status
+      (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p))))
+
 (defclass planned-action-status (action-status)
   ((planned-p
     :initarg :planned-p :reader action-planned-p
@@ -2293,11 +2368,13 @@ in some previous image, or T if it needs to be done.")
 If true, an integer indexing the action in the list of actions planned."))
   (:documentation "Status of an action in a plan"))
 
+(defmethod print-object ((status planned-action-status) stream)
+  (print-unreadable-object (status stream :type t)
+    (with-slots (stamp done-p planned-p) status
+      (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p :planned-p planned-p))))
+
 (defmethod (setf plan-action-status) (new-status (plan plan-traversal) (o operation) (c component))
-  (prog1
-      (setf (gethash (node-for o c) (plan-visited-actions plan)) new-status)
-    (when (action-done-p new-status)
-      (mark-operation-done o c))))
+  (setf (gethash (node-for o c) (plan-visited-actions plan)) new-status))
 
 (defmethod plan-action-status ((plan plan-traversal) (o operation) (c component))
   (values (gethash (node-for o c) (plan-visited-actions plan))))
@@ -2355,10 +2432,11 @@ If true, an integer indexing the action in the list of actions planned."))
     ;; either our model is wrong or some other process is messing with our files.
     (when (and just-done (not all-present))
       (warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~
-             ~:[~; or~] ~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]"
+             ~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]"
             (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
@@ -2392,7 +2470,7 @@ If true, an integer indexing the action in the list of actions planned."))
 (defmacro while-visiting-action ((p o c) &body body)
   `(call-while-visiting-action ,p ,o ,c #'(lambda () ,@body)))
 
-(defgeneric* traverse-action (operation component needed-in-image-p collect))
+(defgeneric* traverse-action (plan operation component needed-in-image-p))
 
 (defmethod (setf plan-action-status) :after
     (new-status (p sequential-plan) (o operation) (c component))
@@ -2401,58 +2479,40 @@ If true, an integer indexing the action in the list of actions planned."))
 
 (defmethod plan-record-dependency ((plan sequential-plan)
                                    (operation operation) (component component))
-  (declare (ignore plan operation component))
+  (declare (ignorable plan operation component))
   (values))
 
 (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))
-    (let* ((niip (needed-in-image-p operation component))
-           (eniip (and niip needed-in-image-p))
+    (plan-record-dependency plan operation component)
+    (let* ((aniip (needed-in-image-p operation component))
+           (eniip (and aniip needed-in-image-p))
            (status (plan-action-status plan operation component)))
-      (plan-record-dependency plan operation component)
       (when (and status (or (action-done-p status) (action-planned-p status) (not eniip)))
-        ;; Already visited with sufficient level of need-in-image: just return the stamp.
+        ;; Already visited with sufficient need-in-image level: just return the stamp.
+        ;;(DBG :ad status eniip aniip)
         (return (action-stamp status)))
-      (labels ((visit-action (o c plan recurse fun)
-                 (visit-dependencies o c recurse)
+      (labels ((visit-action (niip)
+                 (visit-dependencies operation component
+                                     #'(lambda (o c) (traverse-action plan o c niip)))
                  (multiple-value-bind (stamp done-p)
-                     (compute-action-stamp o c :plan plan)
-                   (funcall fun done-p stamp)))
-               (recurse (niip)
-                 #'(lambda (o c) (traverse-action plan o c niip)))
-               (mark-visited (o c &key stamp planned-p done-p)
-                 (setf (plan-action-status plan o c)
-                       (make-instance 'planned-action-status
-                                      :stamp stamp
-                                      :done-p done-p
-                                      :planned-p (and planned-p (incf (plan-action-count plan)))))
-                 stamp)
-               (revisit-harder ()
-                 (visit-action
-                  operation component plan (recurse t)
-                  #'(lambda (done-p stamp)
-                      (assert (not done-p))
-                      (mark-visited operation component :stamp stamp :planned-p (not done-p))))))
-        (while-visiting-action (plan operation component)
-          (cond
-            (status
-             ;; Already visited, it had all its input up-to-date,
-             ;; wasn't previously need in image but now is.
-             (revisit-harder))
-            (t
-             ;; Not visited yet.
-             (visit-action
-              operation component plan (recurse niip)
-              #'(lambda (done-p stamp)
-                  (let ((add-to-plan-p (and (not done-p) (or niip (eql stamp t)))))
-                    (cond
-                      ((and add-to-plan-p (not niip))
-                       (revisit-harder))
-                      (t
-                       (mark-visited
-                        operation component
-                        :stamp stamp :done-p done-p :planned-p add-to-plan-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!
+                       (t
+                        (setf (plan-action-status plan operation component)
+                              (make-instance 'planned-action-status
+                                             :stamp stamp
+                                             :done-p (and done-p (not add-to-plan-p))
+                                             :planned-p (and add-to-plan-p (incf (plan-action-count plan)))))
+                        stamp))))))
+        (while-visiting-action (plan operation component) ; maintain context, handle circularity.
+          (visit-action eniip))))))
 
 (defmethod traverse ((o operation) (c component))
   (let ((plan (make-instance 'sequential-plan)))
@@ -2555,7 +2615,7 @@ If true, an integer indexing the action in the list of actions planned."))
          c #'(lambda (&rest flags)
                (apply *compile-op-compile-file-function* source-file
                       :output-file output-file
-                      :external-format (component-external-format c)
+                      #-gcl<2.7 :external-format #-gcl<2.7 (component-external-format c)
                       (append flags (compile-op-flags o)))))
       (unless output
         (error 'compile-error :component c :operation o))
@@ -2911,6 +2971,7 @@ T to force the inside of the specified system to be rebuilt (resp. not),
 (defun* find-class* (x &optional (errorp t) environment)
   (etypecase x
     ((or standard-class built-in-class) x)
+    #+gcl<2.7 (keyword nil)
     (symbol (find-class x errorp environment))))
 
 (defun* class-for-type (parent type)
@@ -2918,10 +2979,10 @@ T to force the inside of the specified system to be rebuilt (resp. not),
                              type
                              (find-symbol* type *package*)
                              (find-symbol* type :asdf))
-        :for class = (and symbol (find-class symbol nil))
+        :for class = (and symbol (find-class* symbol nil))
         :when (and class
                    (#-cormanlisp subtypep #+cormanlisp cl::subclassp
-                                 class (find-class 'component)))
+                                 class (find-class* 'component)))
         :return class)
       (and (eq type :file)
            (find-class*
@@ -2930,32 +2991,6 @@ T to force the inside of the specified system to be rebuilt (resp. not),
                 *default-component-class*) nil))
       (sysdef-error "don't recognize component type ~A" type)))
 
-(defun* maybe-add-tree (tree op1 op2 c)
-  "Add the node C at /OP1/OP2 in TREE, unless it's there already.
-Returns the new tree (which probably shares structure with the old one)"
-  (let ((first-op-tree (assoc op1 tree)))
-    (if first-op-tree
-        (progn
-          (aif (assoc op2 (cdr first-op-tree))
-               (if (find c (cdr it) :test #'equal)
-                   nil
-                   (setf (cdr it) (cons c (cdr it))))
-               (setf (cdr first-op-tree)
-                     (acons op2 (list c) (cdr first-op-tree))))
-          tree)
-        (acons op1 (list (list op2 c)) tree))))
-
-(defun* union-of-dependencies (&rest deps)
-  (let ((new-tree nil))
-    (dolist (dep deps)
-      (dolist (op-tree dep)
-        (dolist (op  (cdr op-tree))
-          (dolist (c (cdr op))
-            (setf new-tree
-                  (maybe-add-tree new-tree (car op-tree) (car op) c))))))
-    new-tree))
-
-
 (defvar *serial-depends-on* nil)
 
 (defun* sysdef-error-component (msg type name value)
@@ -2988,7 +3023,7 @@ Returns the new tree (which probably shares structure with the old one)"
              (remove-method (symbol-function name) m))
          (component-inline-methods component)))
   ;; clear methods, then add the new ones
-  (setf (component-inline-methods component) nil))
+  (component-inline-methods component) nil)
 
 (defun* %define-component-inline-methods (ret rest)
   (dolist (name +asdf-methods+)
@@ -3302,17 +3337,18 @@ located."
   (pathname-directory-pathname (system-source-file system-designator)))
 
 (defun* relativize-directory (directory)
-  (cond
-    ((stringp directory)
-     (list :relative directory))
-    ((eq (car directory) :absolute)
-     (cons :relative (cdr directory)))
-    (t
-     directory)))
+  (let ((directory (normalize-pathname-directory-component directory)))
+    (cond
+      ((stringp directory)
+       (list :relative directory))
+      ((eq (car directory) :absolute)
+       (cons :relative (cdr directory)))
+      (t
+       directory))))
 
 (defun* relativize-pathname-directory (pathspec)
   (let ((p (pathname pathspec)))
-    (make-pathname
+    (make-pathname*
      :directory (relativize-directory (pathname-directory p))
      :defaults p)))
 
@@ -3616,7 +3652,7 @@ and the order is by decreasing length of namestring of the source pathname.")
 (defun* output-translations ()
   (car *output-translations*))
 
-(defun* (setf output-translations) (new-value)
+(defun* set-output-translations (new-value)
   (setf *output-translations*
         (list
          (stable-sort (copy-list new-value) #'>
@@ -3627,6 +3663,7 @@ and the order is by decreasing length of namestring of the source pathname.")
                                   (let ((directory (pathname-directory (car x))))
                                     (if (listp directory) (length directory) 0))))))))
   new-value)
+(defsetf output-translations set-output-translations) ; works with gcl 2.6
 
 (defun* output-translations-initialized-p ()
   (and *output-translations* t))
@@ -3697,7 +3734,7 @@ directive.")
              ;; special magic! we encode such paths as relative pathnames,
              ;; but it means "relative to the root of the source pathname's host and device".
              (return-from resolve-absolute-location-component
-               (let ((p (make-pathname :directory '(:relative))))
+               (let ((p (make-pathname* :directory '(:relative))))
                  (if wilden (wilden p) p))))
             ((eql :home) (user-homedir))
             ((eql :here)
@@ -3880,7 +3917,7 @@ Please remove it from your ASDF configuration"))
                                         (inherit *default-output-translations*)
                                         collect)
   (process-output-translations (funcall x) :inherit inherit :collect collect))
-(defmethod process-output-translations ((pathname pathname) &key inherit collect)
+(defmethod process-output-translations ((pathname #-gcl<2.7 pathname #+gcl<2.7 t) &key inherit collect)
   (cond
     ((directory-pathname-p pathname)
      (process-output-translations (validate-output-translations-directory pathname)
@@ -4171,7 +4208,7 @@ with a different configuration, so the configuration would be re-read then."
   (values))
 
 (defparameter *wild-asd*
-  (make-pathname :directory nil :name *wild* :type "asd" :version :newest))
+  (make-pathname* :directory nil :name *wild* :type "asd" :version :newest))
 
 (defun* filter-logical-directory-results (directory entries merger)
   (if (typep directory 'logical-pathname)
@@ -4395,7 +4432,7 @@ with a different configuration, so the configuration would be re-read then."
 
 (defmethod process-source-registry ((x symbol) &key inherit register)
   (process-source-registry (funcall x) :inherit inherit :register register))
-(defmethod process-source-registry ((pathname pathname) &key inherit register)
+(defmethod process-source-registry ((pathname #-gcl<2.7 pathname #+gcl<2.7 t) &key inherit register)
   (cond
     ((directory-pathname-p pathname)
      (let ((*here-directory* (truenamize pathname)))
@@ -5058,14 +5095,14 @@ using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
 (defclass precompiled-system (system)
   ((fasl :initarg :fasl :reader %system-fasl)))
 
-(defgeneric* system-fasl (system)
-  (:method ((system precompiled-system))
-    (let* ((f (%system-fasl system))
-           (p (etypecase f
-                ((or pathname string) f)
-                (function (funcall f))
-                (cons (eval f)))))
-      (pathname p))))
+(defgeneric* system-fasl (system))
+(defmethod system-fasl ((system precompiled-system))
+  (let* ((f (%system-fasl system))
+         (p (etypecase f
+              ((or pathname string) f)
+              (function (funcall f))
+              (cons (eval f)))))
+    (pathname p)))
 
 (defmethod input-files ((o load-op) (s precompiled-system))
   (declare (ignorable o))
diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script
index d7450f956410c636077b22d93773fc38ee3875cf..77c9acbb4a363e8b6781d41e625e3cfb2487a607 100644
--- a/test/asdf-pathname-test.script
+++ b/test/asdf-pathname-test.script
@@ -56,6 +56,7 @@
                                              (cons "asdf-src" path)))
                (bin-dir (&rest path) (append (or (pathname-directory root) (list :relative))
                                              (cons "asdf-bin" path))))
+          #-gcl<2.7
           (setf (logical-pathname-translations "ASDFTEST")
                 `((,(format nil "**;*.~a" bin-type)
                    ,(make-pathname :directory (bin-dir :wild-inferiors)
@@ -316,7 +317,7 @@
  (format t "output translations: ~S~%" (asdf::output-translations))
 
  #+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*)))
- #-xcl ;;---*** pathnames are known to be massively broken on XCL
+ #-(or xcl gcl<2.7) ;;---*** pathnames are known to be massively broken on XCL and GCL 2.6
  (flet ((same (s1 s2 p1 p2)
           (unless (equal (namestring p1) (namestring p2))
             (describe p1) (describe p2)
@@ -331,7 +332,7 @@
      #-gcl
      (x (asdf::resolve-location '("/foo" "bar" :**/ "baz" #p"*.*") :directory nil :wilden t) #p"/foo/bar/**/baz/*.*")))
 
- #-xcl ;;---*** pathnames are known to be massively broken on XCL
+ #-(or xcl gcl<2.7) ;;---*** pathnames are known to be massively broken on XCL and GCL 2.6
  (or (test-component-pathnames :delete-host t :support-string-pathnames nil)
      (leave-lisp "test failed" 1)))
 
diff --git a/test/compile-asdf.lisp b/test/compile-asdf.lisp
index 76f0f2bdc94a71ea182e22ac195dacd7f9773671..1d3817aa4114eeac7b0985f2342d20a9f2fbfc6d 100644
--- a/test/compile-asdf.lisp
+++ b/test/compile-asdf.lisp
@@ -1,17 +1,26 @@
-(in-package #:common-lisp-user)
+(cl:in-package :common-lisp-user)
 
-(load (make-pathname :name "script-support" :defaults *load-pathname*))
+(defun load-pathname ()
+  #-gcl *load-pathname*
+  #+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011
+  (symbol-value
+   (find-symbol
+    "*LOAD-PATHNAME*"
+    (if (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all
+            (and (= system::*gcl-major-version* 2)
+                 (< system::*gcl-minor-version* 7)))
+        :system :cl))))
 
-(in-package #:asdf-test)
+(load (make-pathname :name "script-support" :type "lisp" :defaults (load-pathname))
+      #+gcl :print #+gcl t)
 
-(declaim (optimize (speed 2) (safety 3) #-allegro (debug 3)
+(in-package :asdf-test)
+
+(declaim (optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)
 		   #+(or cmu scl) (c::brevity 2)))
-(proclaim '(optimize (speed 2) (safety 3) #-allegro (debug 3)
+(proclaim '(optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)
 		     #+(or cmu scl) (c::brevity 2)))
 
-(defun my-compile-file (&rest args) (apply 'compile-file args))
-#+ecl (trace my-compile-file)
-
 (cond
   ((not (probe-file *asdf-lisp*))
    (leave-lisp "Testsuite failed: unable to find ASDF source" 3))
@@ -20,27 +29,10 @@
         (ignore-errors (load *asdf-fasl*)))
    (leave-lisp "Reusing previously-compiled ASDF" 0))
   (t
-   #+clisp (load-asdf-lisp)
+   (load-asdf-lisp)
    (let ((tmp (make-pathname :name "asdf-tmp" :defaults *asdf-fasl*)))
-     (ensure-directories-exist *asdf-fasl*)
      (multiple-value-bind (result warnings-p errors-p)
-         ;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
-         (handler-bind (#+sbcl (sb-c::simple-compiler-note #'muffle-warning)
-                        #+(and ecl (not ecl-bytecmp))
-			((or c:compiler-note c::compiler-debug-note
-			     c:compiler-warning) ;; ECL emits more serious warnings than it should.
-                               #'muffle-warning)
-                        #+mkcl
-			((or compiler:compiler-note)
-			 #'muffle-warning)
-			#-(or cmu scl)
-                        (style-warning
-                         #'(lambda (w)
-                             ;; escalate style-warnings to warnings - we don't want them.
-                             (warn "Can you please fix ASDF to not emit style-warnings? Got a ~S:~%~A"
-                              (type-of w) w)
-                             (muffle-warning w))))
-           (my-compile-file *asdf-lisp* :output-file tmp :print t :verbose t))
+         (compile-asdf tmp)
        (declare (ignore result))
        (cond
          (errors-p
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 1bbeff918ccf256c436bf9349e3e00a507976889..fc86f5fbcc03c588a551366a2b7ff176e0addffe 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -12,7 +12,7 @@ usage () {
     echo " - quit with exit status >0 if an unhandled error occurs"
     echo " you need to supply the .script in the second argument"
     echo " lisps include abcl, allegro, allegromodern, ccl (clozure),"
-    echo "  clisp, cmucl, ecl, gclcvs, sbcl, and scl."
+    echo "  clisp, cmucl, ecl, gcl, gclcvs, sbcl, scl and xcl."
     echo "OPTIONS:"
     echo "    -d -- debug mode"
     echo "    -u -h -- show this message."
@@ -143,9 +143,14 @@ case "$lisp" in
     command="${ECL:-ecl}"
     flags="-norc -eval (ext::install-bytecodes-compiler)"
     eval="-eval" ;;
+  gcl)
+    export GCL_ANSI=t
+    command="${GCL:-gcl}"
+    flags="-batch"
+    eval="-eval" ;;
   gclcvs)
     export GCL_ANSI=t
-    command="${GCL:-gclcvs}"
+    command="${GCLCVS:-gclcvs}"
     flags="-batch"
     eval="-eval" ;;
   lispworks)
diff --git a/test/script-support.lisp b/test/script-support.lisp
index d83403bbcb4a9fcf3aec67da26c874be54ac110a..84b4356436b1494045cda2f7a68c93969a0be9d9 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -3,17 +3,17 @@
   (:export
    #:*test-directory* #:*asdf-directory*
    #:load-asdf
-   #:register-directory #:asdf-load 
+   #:register-directory #:asdf-load
    #:load-asdf-lisp #:compile-asdf #:load-asdf-fasl #:compile-load-asdf #:load-asdf-system
    #:quit-on-error #:test-asdf
    #:native-namestring
    #:exit-lisp #:leave-lisp
    #:quietly))
 
-(in-package #:asdf-test)
+(in-package :asdf-test)
 
-(declaim (optimize (speed 2) (safety 3) #-allegro (debug 3)))
-(proclaim '(optimize (speed 2) (safety 3) #-allegro (debug 3)))
+(declaim (optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)))
+(proclaim '(optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)))
 
 ;;(format t "Evaluating asdf/test/script-support~%")
 
@@ -21,11 +21,13 @@
 ;; We still want to work despite and host/device funkiness.
 (defparameter *test-directory*
   (make-pathname :name nil :type nil :version nil
-                 :defaults (or *load-truename* *compile-file-truename*)))
+                 :defaults (or #+gcl (truename system:*load-pathname*)
+                               *load-truename* *compile-file-truename*)))
 (defparameter *asdf-directory*
-  (merge-pathnames
-   (make-pathname :directory '(:relative :back) :defaults *test-directory*)
-   *test-directory*))
+  (truename
+   (merge-pathnames
+    (make-pathname :directory '(#-gcl :relative #-gcl :back #+gcl :parent) :defaults *test-directory*)
+    *test-directory*)))
 (defparameter *asdf-lisp*
   (make-pathname :name "asdf" :type "lisp" :defaults *asdf-directory*))
 (defparameter *asdf-fasl*
@@ -49,26 +51,37 @@
                     #+scl :scl
                     #+xcl :xcl))))
      (merge-pathnames
-      (make-pathname :directory `(:relative "tmp" "fasls" ,impl)
+      (make-pathname :directory `(#-gcl :relative "tmp" "fasls" ,impl)
                      :defaults *asdf-directory*)
       *asdf-lisp*))))
 
 (defun load-old-asdf (tag)
   (let ((old-asdf
           (merge-pathnames
-           (make-pathname :directory `(:relative "tmp")
+           (make-pathname :directory `(#-gcl :relative "tmp")
                           :name (format nil "asdf-~A" tag)
                           :defaults *asdf-directory*)
            *asdf-lisp*)))
     (handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning))
       (load old-asdf))))
 
+(defun configure-asdf ()
+  (funcall (find-symbol (string :initialize-source-registry) :asdf)
+           `(:source-registry :ignore-inherited-configuration))
+  (let ((registry (find-symbol (string :*central-registry*) :asdf)))
+    (set registry `(,*asdf-directory* ,*test-directory*))))
+
 (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)))
 
+(defun hash-table->alist (table)
+  (loop :for key :being :the :hash-keys :of table :using (:hash-value value)
+    :collect (cons key value)))
+
 (defun common-lisp-user::load-asdf ()
   (load-asdf))
 
@@ -164,9 +177,31 @@ is bound, write a message and exit on an error.  If
 (defun load-asdf-lisp ()
   (load *asdf-lisp*))
 
-(defun compile-asdf ()
+#+(or gcl genera)
+(unless (fboundp 'ensure-directories-exist)
+  (defun ensure-directories-exist (path)
+    #+genera (fs:create-directories-recursively (pathname path))
+    #+gcl (lisp:system (format nil "mkdir -p ~S" (namestring (make-pathname :name nil :type nil :defaults path))))))
+
+(defun compile-asdf (&optional (output *asdf-fasl*))
   (ensure-directories-exist *asdf-fasl*)
-  (compile-file *asdf-lisp* :output-file *asdf-fasl* :verbose t :print t))
+  ;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
+  (handler-bind (#+sbcl (sb-c::simple-compiler-note #'muffle-warning)
+                 #+(and ecl (not ecl-bytecmp))
+                 ((or c:compiler-note c::compiler-debug-note
+                      c:compiler-warning) ;; ECL emits more serious warnings than it should.
+                   #'muffle-warning)
+                 #+mkcl
+                 ((or compiler:compiler-note)
+                   #'muffle-warning)
+                 #-(or cmu scl)
+                 (style-warning
+                   #'(lambda (w)
+                       ;; escalate style-warnings to warnings - we don't want them.
+                       (warn "Can you please fix ASDF to not emit style-warnings? Got a ~S:~%~A"
+                             (type-of w) w)
+                       (muffle-warning w))))
+    (compile-file *asdf-lisp* :output-file output #-gcl :verbose #-gcl t :print t)))
 
 (defun load-asdf-fasl ()
   (load *asdf-fasl*))
@@ -220,6 +255,12 @@ outputs a tag plus a list of variable and their values, returns the last value"
 
 (pushnew :DBG *features*)
 
+#+gcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (DBG :script-support *package* *test-directory* *asdf-directory* *asdf-lisp* *asdf-fasl*
+       ))
+
+
 #|
-#+DBG (DBG :cas o c just-done base-stamp stamp-lookup out-files in-files file-op null-op op-time op-stamp dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in done-stamp (stamp<= latest-in earliest-out) (operation-done-p o c))
+(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))
 |#
diff --git a/test/test-builtin-source-file-type.script b/test/test-builtin-source-file-type.script
index 481c67fcf35ed829a25737f2d16345b902b4ded7..505495b4431e79055962a1732ce5ddd0bdcc02f7 100644
--- a/test/test-builtin-source-file-type.script
+++ b/test/test-builtin-source-file-type.script
@@ -6,8 +6,7 @@
 
 (quit-on-error
  (format t "~D~%" (asdf:asdf-version))
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
- (asdf:load-system 'test-builtin-source-file-type-1 :verbose t)
+ (load-system 'test-builtin-source-file-type-1 :verbose t)
  (assert (symbol-value (read-from-string "test-package::*test-tmp-cl*")))
  (assert-equal
   (mapcar #'pathname-type
@@ -24,5 +23,4 @@
   '("lisp" "cl"))
  (delete-package :test-package)
  (asdf:load-system 'test-builtin-source-file-type-4 :verbose t)
- (assert (symbol-value (read-from-string "test-package::*test-tmp-cl*")))
- )
+ (assert (symbol-value (read-from-string "test-package::*test-tmp-cl*"))))
diff --git a/test/test-logical-pathname.script b/test/test-logical-pathname.script
index 7441e7276913191156878eb802655df096b768f2..0853adc75e660f9e469ed212c72afeee0163124c 100644
--- a/test/test-logical-pathname.script
+++ b/test/test-logical-pathname.script
@@ -2,6 +2,7 @@
 (load "script-support.lisp")
 (load-asdf)
 
+#-gcl<2.7
 (setf (logical-pathname-translations "ASDF")
       #+(or allegro clisp)
       `(("**;*.*.*" ,(asdf::wilden *asdf-directory*)))
@@ -16,14 +17,14 @@
  (format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd"))
  (format t "~S~%" (truename "ASDF:test;test-force.asd"))
 
- #-xcl
+ #-(or xcl gcl<2.7)
  (progn
    (format t "Test logical pathnames in central registry~%")
    (setf *central-registry* '(#p"ASDF:test;"))
    (initialize-source-registry '(:source-registry :ignore-inherited-configuration))
    (load-system :test-logical-pathname :force t))
 
- #-xcl
+ #-(or xcl gcl<2.7)
  (progn
    (format t "Test logical pathnames in source-registry, non-recursive~%")
    (clear-system :test-logical-pathname)
@@ -32,7 +33,7 @@
     '(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration))
    (load-system :test-logical-pathname :force t))
 
- #-xcl
+ #-(or xcl gcl<2.7)
  (progn
    (format t "Test logical pathnames in source-registry, recursive~%")
    (clear-system :test-logical-pathname)
diff --git a/test/test-nested-1.lisp b/test/test-nested-1.lisp
index bcee43e8834ed542b89e211153a7c771cf5d8bd0..5bbe01d9132c96156a3fabd5872db24e6339d5de 100644
--- a/test/test-nested-1.lisp
+++ b/test/test-nested-1.lisp
@@ -1 +1 @@
-(in-package #:asdf-test)
+(in-package :asdf-test)
diff --git a/test/test-nested-components-1.asd b/test/test-nested-components-1.asd
index cb27c953f54d063455126dced118ab3b6a309275..79a8df3e32003b79a8de6f0578c42e4741fd1f05 100644
--- a/test/test-nested-components-1.asd
+++ b/test/test-nested-components-1.asd
@@ -1,11 +1,11 @@
 ;;; -*- Mode: common-lisp; Syntax: Common-Lisp; -*-
 
-(in-package #:common-lisp-user)
+(in-package :common-lisp-user)
 
 (defpackage #:test-nested-components.system
             (:use #:common-lisp #:asdf))
 
-(in-package #:test-nested-components.system)
+(in-package :test-nested-components.system)
 
 (defsystem test-nested-components-a
   :components
diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script
index 0e2c9ca38c12d3a0a05db606d0de18bb9d912a5a..8ec9180cf5a1ac48db538b32b183501f8741e84d 100644
--- a/test/test-retry-loading-component-1.script
+++ b/test/test-retry-loading-component-1.script
@@ -4,35 +4,27 @@
 
 (load "script-support.lisp")
 (load-asdf)
-;(trace asdf::find-component)
-;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate)
-;#+allegro
-;(trace excl.osi:command-output)
 (defvar *caught-error* nil)
 (quit-on-error
- ;;(format t "trlc1 1~%")
- (when (probe-file "try-reloading-dependency.asd")
-   (asdf:run-shell-command "rm -f ~A"
-                           (namestring "try-reloading-dependency.asd")))
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
+ (DBG "trlc1 1")
+ (asdf::delete-file-if-exists "try-reloading-dependency.asd")
  (setf asdf::*defined-systems* (asdf::make-defined-systems-table))
- ;;(format t "trlc1 2~%")
+ (DBG "trlc1 2")
  (handler-bind ((error (lambda (c)
                          (format t "~&Caught error ~s" c)
                          (setf *caught-error* t)
                          (asdf:run-shell-command
                           "cp try-reloading-dependency.hidden try-reloading-dependency.asd")
-                         ;;(format t "trlc1 5~%")
+                         (DBG "trlc1 5")
                          (multiple-value-bind (name mode)
                              (find-symbol (symbol-name 'retry) :asdf)
+                           (DBG "trlc1 6" name mode)
                            (assert (eq mode :external) nil "Mode of ~s was not external" name)
-                           ;;(format t "trlc1 6~%")
                            (let ((restart (find-restart name c)))
-                             ;;(format t "trlc1 7~%")
+                             (DBG "trlc1 7" restart)
                              (assert restart)
-                             (format t "~&restart: ~S~&" restart)
                              (when restart (invoke-restart restart)))))))
-   ;;(format t "trlc1 3~%")
+   (DBG "trlc1 3")
    (asdf:oos 'asdf:load-op 'try-reloading-1))
- ;;(format t "trlc1 4~%")
+ (DBG "trlc1 4")
  (assert *caught-error*))
diff --git a/test/test-tmp.cl b/test/test-tmp.cl
index 7e8dd8594e9a76189926b11d1fd2641ee0744aa9..c92fb1c8ee04e89a78ac9054e38acccbd34a02cb 100644
--- a/test/test-tmp.cl
+++ b/test/test-tmp.cl
@@ -1,6 +1,6 @@
 ;; part of the test-module-pathnames test
 
-(in-package #:test-package)
+(in-package :test-package)
 
 (defparameter *test-tmp-cl* t)
 
diff --git a/test/test-tmp.lsp b/test/test-tmp.lsp
index 9792546537c2724feade035a2cfa35e9779d52ec..efa485c01c2f044c1ed0bde1c65778dbd53c0b14 100644
--- a/test/test-tmp.lsp
+++ b/test/test-tmp.lsp
@@ -1,6 +1,6 @@
 ;; part of the test-module-pathnames test
 
-(in-package #:test-package)
+(in-package :test-package)
 
 (defparameter *test-tmp-cl* t)
 
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 8cf58624d47600547d9f6f1077394e3bab7e5e0c..0def8b241138c1b54c1fd002147b1a6371a0080e 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -10,9 +10,9 @@
 (assert
  (every #'directory-pathname-p
   (list
-   (make-pathname :name nil :type "" :directory '(:absolute "tmp"))
-   (make-pathname :name "" :directory '(:absolute "tmp"))
-   (make-pathname :type "" :directory '(:absolute "tmp"))
+   (make-pathname* :name nil :type "" :directory '(:absolute "tmp"))
+   (make-pathname* :name "" :directory '(:absolute "tmp"))
+   (make-pathname* :type "" :directory '(:absolute "tmp"))
 ;; CLHS 19.2.2.2.3 says we can't portably specify :unspecific here,
 ;; and some implementations will enforce it.
 ;;   (make-pathname :type :unspecific :directory '(:absolute "tmp"))
@@ -22,11 +22,11 @@
 (assert
  (every (complement #'directory-pathname-p)
   (list
-   (make-pathname :name "foo" :type nil :directory '(:absolute "tmp"))
-   (make-pathname :name nil :type "bar" :directory '(:absolute "tmp")))))
+   (make-pathname* :name "foo" :type nil :directory '(:absolute "tmp"))
+   (make-pathname* :name nil :type "bar" :directory '(:absolute "tmp")))))
 ;; These are funky and non portable. Omit from tests.
-;; (make-pathname :name "." :type nil :directory '(:absolute "tmp"))
-;; (make-pathname :name "." :type "" :directory '(:absolute "tmp"))
+;; (make-pathname* :name "." :type nil :directory '(:absolute "tmp"))
+;; (make-pathname* :name "." :type "" :directory '(:absolute "tmp"))
 (assert (equal (multiple-value-list (component-name-to-pathname-components "" :force-directory t))
                '(:relative nil nil)))
 (assert (equal (multiple-value-list (component-name-to-pathname-components ""  :force-directory nil))
diff --git a/test/test1.preferences b/test/test1.preferences
index d2d1bca648fe0f3d1ad6b20eda7a1379e5ff3eac..2d6bfa639efaed8a30c486a9411cbecd880f82a9 100644
--- a/test/test1.preferences
+++ b/test/test1.preferences
@@ -1,3 +1,3 @@
-(in-package #:asdf-test)
+(in-package :asdf-test)
 
 (setf *test6* :yes)
diff --git a/test/test8.script b/test/test8.script
index 537de449298b343b6d559ac85339a4473f50fff4..caebad04704a72ee1472eb00fac8038930ef5a18 100644
--- a/test/test8.script
+++ b/test/test8.script
@@ -4,7 +4,7 @@
 
 (load "script-support.lisp")
 (load-asdf)
-(in-package #:asdf-test)
+(in-package :asdf-test)
 
 (quit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
diff --git a/test/try-recompiling-1.lisp b/test/try-recompiling-1.lisp
index e60bc4fabf3e02debc59e1adef694df741ef7144..723999c8f13fae43b619f6b7d6292725885e6820 100644
--- a/test/try-recompiling-1.lisp
+++ b/test/try-recompiling-1.lisp
@@ -1,4 +1,4 @@
-(in-package #:asdf-test)
+(in-package :asdf-test)
 
 #+clisp (eval-when (:compile-toplevel) (fmakunbound 'try-recompiling-1))
 
diff --git a/test/wild-module.script b/test/wild-module.script
index 2e8feb714faec97d86f2b2dfaa4e5fcaa0da9350..3f38ac4a734bc3d6a0f9d58dd4996113396edaec 100644
--- a/test/wild-module.script
+++ b/test/wild-module.script
@@ -2,6 +2,5 @@
 (load "script-support.lisp")
 (load-asdf)
 (quit-on-error
- (load "../wild-modules.lisp")
- (setf *central-registry* '(*default-pathname-defaults*))
+ (load (asdf:system-relative-pathname :asdf "wild-modules.lisp"))
  (load-system :wild-module))