From 2c9f60b85b516290a38b77226e2691ea328518b1 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 18 Nov 2013 15:26:54 -0500
Subject: [PATCH] More cleanups for GCL support.

---
 test/run-tests.sh                  |  4 ++--
 test/script-support.lisp           | 18 ++++++++----------
 test/test-bundle.script            |  2 +-
 test/test-system-pathnames.script  |  2 +-
 test/test-try-recompiling-1.script |  2 --
 test/test2.script                  |  4 ++--
 uiop/os.lisp                       |  2 +-
 7 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/test/run-tests.sh b/test/run-tests.sh
index dc53ca39..9fdc9aeb 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -346,8 +346,8 @@ valid_upgrade_test_p () {
         cmucl:1.*|cmucl:2.00*|cmucl:2.01[0-6]:*) : ;;
         # Skip many ECL tests, for various ASDF issues
         ecl*:1.*|ecl*:2.0[01]*|ecl*:2.20:*) : ;;
-        # GCL 2.6 is only supported with ASDF 2.27, so skip earlier versions
-        gcl:1.*|gcl:2.0*|gcl:2.2[0-6]*) : ;;
+        # GCL 2.7.0 from late November 2013 is required, with ASDF 3.1.1
+        gcl:1.*|gcl:2.*|gcl:3.0*) : ;;
         # MKCL is only supported starting with 2.24, so skip earlier versions
         mkcl:1.*|mkcl:2.0[01]*|mkcl:2.2[0-3]:*) : ;;
         # XCL support starts with ASDF 2.014.2
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 795cdce1..22bb2157 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -33,9 +33,9 @@ Some constraints:
 
 (in-package :asdf-test)
 
-(declaim (optimize (speed 2) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
+(declaim (optimize (speed 2) (safety #-gcl 3 #+gcl 1) #-(or allegro gcl genera) (debug 3)
                    #+(or cmu scl) (c::brevity 2)))
-(proclaim '(optimize (speed #-gcl 2 #+gcl 1) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
+(proclaim '(optimize (speed #-gcl 2 #+gcl 1) (safety #-gcl 3 #+gcl 1) #-(or allegro gcl genera) (debug 3)
                      #+(or cmu scl) (c::brevity 2)))
 
 (defvar *trace-symbols*
@@ -184,14 +184,12 @@ Some constraints:
                   :defaults (or *load-pathname* *compile-file-pathname* *default-pathname-defaults*))))
 (defun make-sub-pathname (&rest keys &key defaults &allow-other-keys)
   (merge-pathnames (apply 'make-pathname keys) defaults))
-(defun relative-dir (&rest dir) #-gcl (cons ':relative dir) #+gcl dir)
-(defun back-dir () #-gcl :back #+gcl :parent)
 (defparameter *asdf-directory*
-  (truename (make-sub-pathname :directory (relative-dir (back-dir)) :defaults *test-directory*)))
+  (truename (make-sub-pathname :directory '(:relative :back) :defaults *test-directory*)))
 (defparameter *uiop-directory*
-  (truename (make-sub-pathname :directory (relative-dir "uiop") :defaults *asdf-directory*)))
+  (truename (make-sub-pathname :directory '(:relative "uiop") :defaults *asdf-directory*)))
 (defparameter *build-directory*
-  (make-sub-pathname :directory (relative-dir "build") :defaults *asdf-directory*))
+  (make-sub-pathname :directory '(:relative "build") :defaults *asdf-directory*))
 (defparameter *implementation*
   (or #+allegro
       (ecase excl:*current-case-mode*
@@ -211,7 +209,7 @@ Some constraints:
       #+scl :scl
       #+xcl :xcl))
 (defparameter *early-fasl-directory*
-  (make-sub-pathname :directory (relative-dir "fasls" (string-downcase *implementation*))
+  (make-sub-pathname :directory `(:relative "fasls" ,(string-downcase *implementation*))
                      :defaults *build-directory*))
 
 (defun asdf-name (&optional tag)
@@ -219,7 +217,7 @@ Some constraints:
 (defun asdf-lisp (&optional tag)
   (make-pathname :name (asdf-name tag) :type "lisp" :defaults *build-directory*))
 (defun debug-lisp ()
-  (make-sub-pathname :directory (relative-dir "contrib") :name "debug" :type "lisp" :defaults *uiop-directory*))
+  (make-sub-pathname :directory '(:relative "contrib") :name "debug" :type "lisp" :defaults *uiop-directory*))
 (defun early-compile-file-pathname (file)
   (compile-file-pathname
    (make-pathname :name (pathname-name file) :type "lisp" :defaults *early-fasl-directory*)))
@@ -391,7 +389,7 @@ is bound, write a message and exit on an error.  If
          (tmp (make-pathname :name "asdf-tmp" :defaults afasl)))
     (ensure-directories-exist afasl)
     (multiple-value-bind (result warnings-p failure-p)
-        (compile-file alisp :output-file tmp #-gcl :verbose #-gcl verbose :print verbose)
+        (compile-file alisp :output-file tmp :verbose verbose :print verbose)
       (flet ((bad (key)
                (when result (ignore-errors (delete-file result)))
                key)
diff --git a/test/test-bundle.script b/test/test-bundle.script
index 87d5f15e..2f2dc0c3 100644
--- a/test/test-bundle.script
+++ b/test/test-bundle.script
@@ -14,7 +14,7 @@
 #+(and darwin (or abcl ecl))
 (leave-test "Bundle test doesn't work on Mac on this lisp." 0)
 
-#+(or (and ecl ecl-bytecmp) gcl) ;; actually available on ABCL 1.2.0 and later.
+#+(or (and ecl ecl-bytecmp) gcl)
 (leave-test "bundles not on this implementation" 0)
 
 #+abcl
diff --git a/test/test-system-pathnames.script b/test/test-system-pathnames.script
index 570b9147..dfd650fb 100644
--- a/test/test-system-pathnames.script
+++ b/test/test-system-pathnames.script
@@ -25,7 +25,7 @@
 
 (assert (find-symbol* '*file-tmp2* :test-package nil)
         () "symbol `*file-tmp2*` not found")
-(assert (symbol-value (find-symbol* '*file-tmp2* :test-package)
+(assert (symbol-value (find-symbol* '*file-tmp2* :test-package))
         () "symbol `*file-tmp2*` has wrong value")
 
 (assert (probe-file* (test-fasl "sources/level1/level2/file2"))
diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script
index 4e4a102c..d2cc4658 100644
--- a/test/test-try-recompiling-1.script
+++ b/test/test-try-recompiling-1.script
@@ -8,7 +8,6 @@
 
 (delete-file-if-exists (test-fasl "try-recompiling-1"))
 
-#-gcl
 (handler-bind
     ((error (lambda (c)
               (setf *caught-error* t)
@@ -25,5 +24,4 @@
                     (invoke-restart restart)))))))
   (oos 'load-op 'try-recompiling-1))
 
-#-gcl
 (assert *caught-error*)
diff --git a/test/test2.script b/test/test2.script
index 1101b6a2..24d66277 100644
--- a/test/test2.script
+++ b/test/test2.script
@@ -10,7 +10,7 @@
              (probe-file (test-fasl "file4.lisp"))))
 
 (DBG "test2: loading test2b2 should fail")
-#-gcl
+
 (handler-case
     (asdf:load-system 'test2b2)
   (asdf:missing-dependency (c)
@@ -20,7 +20,7 @@
     (error "should have failed, oops")))
 
 (DBG "test2: loading test2b3 should fail")
-#-gcl
+
 (handler-case
     (asdf:load-system 'test2b3)
   (asdf:missing-dependency (c)
diff --git a/uiop/os.lisp b/uiop/os.lisp
index 8ae5fd65..3cd59810 100644
--- a/uiop/os.lisp
+++ b/uiop/os.lisp
@@ -255,7 +255,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
                         (strcat (nth-value 1 (unix:unix-current-directory)) "/"))
         #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
         #+ecl (ext:getcwd)
-        #+gcl (let ((*default-pathname-defaults* *nil-pathname*)) (truename *nil-pathname*))
+        #+gcl (let ((*default-pathname-defaults* #p"")) (truename #p""))
         #+genera *default-pathname-defaults* ;; on a Lisp OS, it *is* canonical!
         #+lispworks (system:current-directory)
         #+mkcl (mk-ext:getcwd)
-- 
GitLab