From 86243bfd85b8f5e143d7c45f78bb0c99c68fae12 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Fri, 5 Mar 2010 19:48:51 -0500
Subject: [PATCH] 1.629: play nicer with upgrade on CLISP.

---
 asdf.lisp                | 8 ++++----
 test/script-support.lisp | 2 ++
 test/test1.script        | 6 +-----
 3 files changed, 7 insertions(+), 9 deletions(-)

diff --git a/asdf.lisp b/asdf.lisp
index a86b985be..bc48b81ba 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -247,7 +247,7 @@
   ;; This parameter isn't actually user-visible
   ;; -- please use the exported function ASDF:ASDF-VERSION below.
   ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
-  (subseq "VERSION:1.628" (1+ (length "VERSION"))))
+  (subseq "VERSION:1.629" (1+ (length "VERSION"))))
 
 (defun asdf-version ()
   "Exported interface to the version of ASDF currently installed. A string.
@@ -1125,7 +1125,7 @@ to `~a` which is not a directory.~@:>"
 (defmethod source-file-type ((c html-file) (s module)) "html")
 (defmethod source-file-type ((c static-file) (s module)) nil)
 
-(defun merge-component-relative-pathname (name &key type defaults)
+(defun merge-component-name-type (name &key type defaults)
   ;; The defaults are required notably because they provide the default host
   ;; to the below make-pathname, which may crucially matter to
   ;; e.g. people somehow using logical-pathnames.
@@ -1133,7 +1133,7 @@ to `~a` which is not a directory.~@:>"
     (pathname
      name)
     (symbol
-     (merge-component-relative-pathname (string-downcase name) :type type :defaults defaults))
+     (merge-component-name-type (string-downcase name) :type type :defaults defaults))
     (string
      (multiple-value-bind (relative path filename)
          (component-name-to-pathname-components name (eq type :directory))
@@ -1153,7 +1153,7 @@ to `~a` which is not a directory.~@:>"
                           :host host :device device)))))))
 
 (defmethod component-relative-pathname ((component component))
-  (merge-component-relative-pathname
+  (merge-component-name-type
    (or (slot-value component 'relative-pathname)
        (component-name component))
    :type (source-file-type component (component-system component))
diff --git a/test/script-support.lisp b/test/script-support.lisp
index fa62bd40d..6db18a8f3 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -45,8 +45,10 @@ is bound, write a message and exit on an error.  If
                   ((ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST"))
                    (break))
                   (t
+                   (format *error-output* "ABORTING:~% ~S~%" c)
                    #+sbcl (sb-debug:backtrace 69)
                    #+clozure (ccl:print-call-history :count 69 :start-frame-number 1)
+                   (format *error-output* "ABORTING:~% ~S~%" c)
                    (leave-lisp "~&Script failed~%" 1))))))
     (funcall thunk)
     (leave-lisp "~&Script succeeded~%" 0)))
diff --git a/test/test1.script b/test/test1.script
index b4e3747e5..a0306b6c3 100644
--- a/test/test1.script
+++ b/test/test1.script
@@ -4,12 +4,8 @@
 
 (quit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
- (format t "blah ~S~%" asdf:*central-registry*)
- (describe (asdf:find-system 'test1))
- (trace asdf:operate asdf:perform asdf::merge-component-relative-pathname
-        asdf:component-name asdf:component-pathname)
+ ;;(trace ASDF::MERGE-COMPONENT-RELATIVE-PATHNAME ASDF::COMPONENT-RELATIVE-PATHNAME)
  (asdf:operate 'asdf:load-op 'test1)
- (format t "blah~%")
  ;; test that it compiled
  (let* ((file1 (asdf:compile-file-pathname* "file1"))
         (file2 (asdf:compile-file-pathname* "file2"))
-- 
GitLab