From cfd78a311b0044974351acfff63dc0bd627171e4 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 28 Jan 2013 15:42:15 -0500
Subject: [PATCH] 2.26.161: fixes for SCL. Interactive testing on all lisps.
 Fix to a-d.asd

---
 Makefile                   | 19 +++++--------------
 asdf-driver.asd            |  4 ++--
 asdf.asd                   |  2 +-
 header.lisp                |  2 +-
 os.lisp                    |  6 +++---
 pathname.lisp              | 10 ++++++----
 test/run-tests.sh          | 13 +++++++++++--
 test/script-support.lisp   |  7 +++++++
 test/test-utilities.script | 27 ++++++++++-----------------
 upgrade.lisp               |  2 +-
 version.lisp-expr          |  2 +-
 11 files changed, 48 insertions(+), 46 deletions(-)

diff --git a/Makefile b/Makefile
index e00afdf5c..f4554f2ca 100644
--- a/Makefile
+++ b/Makefile
@@ -44,25 +44,16 @@ XCL ?= xcl
 header_lisp := header.lisp
 driver_lisp := package.lisp common-lisp.lisp utility.lisp os.lisp pathname.lisp filesystem.lisp stream.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
 defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp
+all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
 
 # Making ASDF itself should be our first, default, target:
-build/asdf.lisp: $(wildcard *.lisp)
+build/asdf.lisp: $(all_lisp)
 	mkdir -p build
-	cat $(header_lisp) $(driver_lisp) $(defsystem_lisp) > $@
+	cat $(all_lisp) > $@
 
 # This quickly locates such mistakes as unbalanced parentheses:
-load: load-in-sbcl
-
-load-in-sbcl: build/asdf.lisp
-	rlwrap sbcl --eval '(setf *load-verbose* t *compile-verbose* t)' \
-	`for i in $(driver_lisp) $(defsystem_lisp) ; do echo --load $$i ; done` \
-	--eval '(in-package :asdf)'
-
-load-in-cmucl: build/asdf.lisp
-	rlwrap cmucl -eval '(setf *load-verbose* t *compile-verbose* t *gc-verbose* nil)' \
-	`for i in $(driver_lisp) $(defsystem_lisp) ; do echo -load $$i ; done` \
-	-eval '(in-package :asdf)'
-
+load: build/asdf.lisp
+	./test/run-tests.sh -t $l $(all_lisp)
 
 install: archive-copy
 
diff --git a/asdf-driver.asd b/asdf-driver.asd
index 93ea577a2..6a393912d 100644
--- a/asdf-driver.asd
+++ b/asdf-driver.asd
@@ -2,9 +2,9 @@
 (in-package :asdf)
 
 (defun call-without-redefinition-warnings (thunk)
-  (handler-bind ((or #+clozure ccl:compiler-warning
+  (handler-bind (((or #+clozure ccl:compiler-warning
                      #+cmu kernel:simple-style-warning)
-                 #'muffle-warning)
+                   #'muffle-warning))
     (funcall thunk)))
 
 (defsystem :asdf-driver
diff --git a/asdf.asd b/asdf.asd
index 755252d8e..00bb62535 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -62,7 +62,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.160" ;; to be automatically updated by make bump-version
+  :version "2.26.161" ;; to be automatically updated by make bump-version
   :depends-on ()
   #+asdf3 :encoding #+asdf3 :utf-8
   ;; For most purposes, asdf itself specially counts as a builtin system.
diff --git a/header.lisp b/header.lisp
index 495ab43f8..24854d236 100644
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
-;;; This is ASDF 2.26.160: Another System Definition Facility.
+;;; This is ASDF 2.26.161: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/os.lisp b/os.lisp
index c800baaa9..68423a8a1 100644
--- a/os.lisp
+++ b/os.lisp
@@ -194,11 +194,11 @@ then returning the non-empty string value of the variable"
 
 
 ;;; Current directory
-#+(or cmu scl)
+#+cmu
 (defun* parse-unix-namestring* (unix-namestring)
   (multiple-value-bind (host device directory name type version)
       (lisp::parse-unix-namestring unix-namestring 0 (length unix-namestring))
-    (make-pathname :host (or host #+cmu lisp::*unix-host*) :device device
+    (make-pathname :host (or host lisp::*unix-host*) :device device
                    :directory directory :name name :type type :version version)))
 
 (defun* getcwd ()
@@ -208,7 +208,7 @@ then returning the non-empty string value of the variable"
       #+allegro (excl::current-directory)
       #+clisp (ext:default-directory)
       #+clozure (ccl:current-directory)
-      #+(or cmu scl) (parse-unix-namestring*
+      #+(or cmu scl) (#+cmu parse-unix-namestring* #+scl lisp::parse-unix-namestring
                       (strcat (nth-value 1 (unix:unix-current-directory)) "/"))
       #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
       #+ecl (ext:getcwd)
diff --git a/pathname.lisp b/pathname.lisp
index 30c64c607..7037d4a41 100644
--- a/pathname.lisp
+++ b/pathname.lisp
@@ -180,10 +180,12 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL."
   ;; see also "valid physical pathname host" in the CLHS glossary, that suggests
   ;; strings and lists of strings or :unspecific
   ;; But CMUCL decides to die on NIL.
-  (make-pathname* :directory nil :name nil :type nil :version nil :device nil
-                  :host (or #+cmu lisp::*unix-host*)
-                  ;; the default shouldn't matter, but we really want something physical
-                  :defaults defaults))
+  #.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil
+                     :host (or #+cmu lisp::*unix-host*)
+                     #+scl ,@'(:scheme nil :scheme-specific-part nil
+                               :username nil :password nil :parameters nil :query nil :fragment nil)
+                     ;; the default shouldn't matter, but we really want something physical
+                     :defaults defaults))
 
 (defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname))))
 
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 2952e732f..a7d226855 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -19,11 +19,12 @@ usage () {
     echo "    -u -- upgrade tests."
     echo "    -c -- clean load test"
     echo "    -l -- load systems tests"
+    echo "    -t -- test interactively"
 }
 
-unset DEBUG_ASDF_TEST upgrade clean_load load_systems
+unset DEBUG_ASDF_TEST upgrade clean_load load_systems test_interactively
 
-while getopts "cdhulhu" OPTION
+while getopts "cdthulhu" OPTION
 do
     case $OPTION in
         d)
@@ -38,6 +39,9 @@ do
         l)
             load_systems=t
             ;;
+        t)
+            test_interactively=t
+            ;;
         h)
             usage
             exit 1
@@ -367,9 +371,14 @@ test_load_systems () {
       "(or #.(load \"test/script-support.lisp\") #.(asdf-test::with-test () (asdf-test::test-load-systems ${s})))" \
         2>&1 | tee build/results/${lisp}-systems.text
 }
+test_interactively () {
+    rlwrap $cmd $eval "(or #.(load \"test/script-support.lisp\") #.(asdf-test::interactive-test '($*)))"
+}
 
 if [ -z "$cmd" ] ; then
     echo "Error: cannot find or do not know how to run Lisp named $lisp"
+elif [ -n "$test_interactively" ] ; then
+    test_interactively "$@"
 elif [ -n "$clean_load" ] ; then
     test_clean_load
 elif [ -n "$load_systems" ] ; then
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 849e142f6..eb4325228 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -304,6 +304,13 @@ is bound, write a message and exit on an error.  If
   (handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning))
     (funcall thunk)))
 
+(defun interactive-test (&optional files)
+  (verbose t nil)
+  (loop :for file :in files :do
+    (load (string-downcase file)))
+  (setf *package* (some 'find-package '(:asdf :asdf/driver :asdf/utility :asdf/package :asdf-test)))
+  (load "contrib/debug.lisp"))
+
 (defun load-asdf-lisp (&optional tag)
   (quietly (load (asdf-lisp tag) :verbose *load-verbose* :print *load-print*)))
 
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 435540c03..a16efe0e8 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -1,12 +1,5 @@
 ;;; -*- Lisp -*-
 
-
-
-(in-package :asdf)
-(use-package :asdf-test)
-
-(progn
-
 (assert
  (every #'directory-pathname-p
   (list
@@ -41,20 +34,20 @@
 (assert
  (version-satisfies (asdf-version) (asdf-version)))
 (assert
- (version-satisfies (asdf-version) "2.000"))
+ (version-satisfies (asdf-version) "2.0"))
 (assert
  (not (version-satisfies (asdf-version) "666")))
-(assert-equal
- (mapcar 'namestring (split-native-pathnames-string "foo:bar"))
+(assert-pathnames-equal
+ (split-native-pathnames-string "foo:bar")
  '("foo" "bar"))
-(assert-equal
- (mapcar 'namestring (split-native-pathnames-string "foo:bar" :ensure-directory t))
+(assert-pathnames-equal
+ (split-native-pathnames-string "foo:bar" :ensure-directory t)
  '("foo/" "bar/"))
-(assert-equal
- (mapcar 'namestring (split-native-pathnames-string "/foo:/bar" :want-absolute t))
+(assert-pathnames-equal
+ (split-native-pathnames-string "/foo:/bar" :want-absolute t)
  '("/foo" "/bar"))
-(assert-equal
- (mapcar 'namestring (split-native-pathnames-string "/foo:/bar" :want-absolute t :ensure-directory t))
+(assert-pathnames-equal
+ (split-native-pathnames-string "/foo:/bar" :want-absolute t :ensure-directory t)
  '("/foo/" "/bar/"))
 (assert-equal
  (mapcar 'location-function-p
@@ -66,4 +59,4 @@
            (:function f too many arguments)
            (:function (:lambda isnt lambda))
            (:function (lambda (too many args) blah))))
- '(t t nil nil nil nil)))
+ '(t t nil nil nil nil))
diff --git a/upgrade.lisp b/upgrade.lisp
index f347e0cff..898466658 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -35,7 +35,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.160")
+         (asdf-version "2.26.161")
          (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version))
diff --git a/version.lisp-expr b/version.lisp-expr
index 22c1efebd..16d8e942e 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.160"
+"2.26.161"
-- 
GitLab