From f70b13b5bbaff3a88c9fe6a8c00bfc4d19ef2d49 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Thu, 12 Aug 2010 18:59:59 -0400
Subject: [PATCH] 2.117: fix more breakage from the 2.112 optimization. Fix
 wild-modules to work nicely well with ASDF2. Allow to pass multiple script
 arguments to run-tests.sh. Tests now pass on ABCL.

---
 asdf.lisp                      |  6 ++++--
 test/run-tests.sh              |  6 +++---
 test/test-configuration.script |  5 ++++-
 wild-modules.lisp              | 25 ++++++++++---------------
 4 files changed, 21 insertions(+), 21 deletions(-)

diff --git a/asdf.lisp b/asdf.lisp
index 301fa401..8f122638 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -70,7 +70,7 @@
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate
-          (subseq "VERSION:2.116" (1+ (length "VERSION"))))
+          (subseq "VERSION:2.117" (1+ (length "VERSION"))))
          (existing-asdf (find-package :asdf))
          (vername '#:*asdf-version*)
          (versym (and existing-asdf
@@ -753,8 +753,10 @@ actually-existing directory."
   "when given a pathname P, probes the filesystem for a file or directory
 with given pathname and if it exists return its truename."
   (and (pathnamep p) (not (wild-pathname-p p))
+       #+(or allegro clozure cmu ecl sbcl scl) (probe-file p)
        #+clisp (ext:probe-pathname p)
-       #-clisp (probe-file p)))
+       #-(or allegro clisp clozure cmu ecl sbcl scl)
+       (ignore-errors (truename p))))
 
 (defun* truenamize (p)
   "Resolve as much of a pathname as possible"
diff --git a/test/run-tests.sh b/test/run-tests.sh
index ccac29ee..ec906f83 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -41,11 +41,12 @@ if [ x"$1" = "xhelp" ]; then
     usage
     exit 1
 fi
+lisp=$1 ; shift
 
-if [ -z "$2" ]; then
+if [ -z "$*" ]; then
     scripts="*.script"
 else
-    scripts="$2"
+    scripts="$*"
 fi
 
 sok=1
@@ -98,7 +99,6 @@ do_tests() {
 # terminate on error
 set -e
 
-lisp=$1
 if [ -z $1 ] ; then
     lisp="sbcl"
 fi
diff --git a/test/test-configuration.script b/test/test-configuration.script
index 9b6406cf..a0ec2a88 100644
--- a/test/test-configuration.script
+++ b/test/test-configuration.script
@@ -25,7 +25,7 @@
                            :direction :output
                            :if-exists :supersede)
         (with-standard-io-syntax
-          (format out "~{~S~}" contents))))))
+          (format out "~{~S~%~}" contents))))))
 
 (defparameter *test-asd-directories*
   (loop
@@ -69,6 +69,9 @@
 
 (create-asd-files)
 (create-conf-files)
+
+#+abcl (trace directory)
+
 (initialize-source-registry
  `(:source-registry (:include ,(under-test-directory "conf.d/"))
                     :ignore-inherited-configuration))
diff --git a/wild-modules.lisp b/wild-modules.lisp
index 7a8267d0..033479b5 100644
--- a/wild-modules.lisp
+++ b/wild-modules.lisp
@@ -12,27 +12,22 @@
 use a wild pathname instead." module)))
 
 (defmethod reinitialize-instance :after ((self wild-module) &key)
-  (let ((pathname (slot-value self 'relative-pathname)))
-    (and pathname
-         (not (wild-pathname-p pathname))
-         (sysdef-error "Wild-module ~A specified with non-wild pathname ~A."
-                       self pathname))
+  (let ((pathname (component-pathname self)))
+    (unless (and pathname (wild-pathname-p pathname))
+      (sysdef-error "Wild-module ~A specified with non-wild pathname ~A."
+                    self pathname))
     (setf (slot-value self 'components)
-          (let* ((*default-pathname-defaults* (component-parent-pathname self))
-                 (files (directory (merge-pathnames (component-relative-pathname self))))
+          (let* ((files (directory pathname))
                  (class (wild-module-component-class self))
                  (options (wild-module-component-options self)))
             (mapcar (lambda (file)
                       (apply #'make-instance class
-                             :name (file-namestring file)
-                                        ;; XXX fails when wildcards are in
-                                        ;; the directory or higher parts.
+                             :name (namestring file)
                              :pathname file
                              :parent self
                              options))
-                    files)))))
+                    files)))
+    (compute-module-components-by-name self)
+    (values)))
 
-;; Don't export wild-module or else will get a full warning
-;; when (require :asdf) if asdf is already loaded
-
-;;(export '(wild-module))
+(export 'wild-module)
-- 
GitLab