Commit 2c9f60b8 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

More cleanups for GCL support.

parent 11c144ea
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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"))
......
......@@ -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*)
......@@ -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)
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment