From d42d5371523c510900a165ea2f35f6954a465def Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Tue, 12 Jun 2012 03:39:43 -0400
Subject: [PATCH] sbcl quit update. Don't upgrade ccl or cmucl on older asdf's
 due to incompatibilities. Shouldn't matter since they already ship with more
 recent versions of asdf.

---
 Makefile                 |  8 +++++---
 test/script-support.lisp | 25 +++++++++++++++----------
 2 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/Makefile b/Makefile
index 539bf284b..a1cd2158a 100644
--- a/Makefile
+++ b/Makefile
@@ -105,8 +105,10 @@ test-upgrade:
 	    case ${lisp}:$$tag:$$x in \
 	      ecl:1.*|ecl:2.00*|ecl:2.01[0-6]:*|ecl:2.20:*) \
 		: Skip, because of various ASDF issues ;; \
-	      cmucl:1.*|cmucl:2.00*) \
-		: Skip, CMUCL cannot upgrade from ASDF 1. Happily, it ships ASDF 2 ;; \
+	      ccl:1.*|ccl:2.0[01]*) \
+		: Skip, because ccl broke old asdf ;; \
+	      cmucl:1.*|cmucl:2.00*|cmucl:2.01[0-4]:*) \
+		: Skip, CMUCL has problems before 2.014.7 due to source-registry upgrade ;; \
 	      *) (set -x ; \
                   case $$x in \
 		    load-system) l="$$lo (asdf-test::load-asdf-system)" ;; \
@@ -120,7 +122,7 @@ test-upgrade:
 	done ; done
 
 test-forward-references:
-	${SBCL} --noinform --no-userinit --no-sysinit --load asdf.lisp --eval '(sb-ext:quit)' 2>&1 | cmp - /dev/null
+	${SBCL} --noinform --no-userinit --no-sysinit --load asdf.lisp --load test/script-support.lisp --eval '(asdf-test::exit-lisp 0)' 2>&1 | cmp - /dev/null
 
 test-lisp:
 	@cd test; ${MAKE} clean;./run-tests.sh ${lisp} ${test-glob}
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 16a42a477..6ad9a094c 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -5,7 +5,7 @@
 (declaim (optimize (speed 2) (safety 3) #-allegro (debug 3)))
 (proclaim '(optimize (speed 2) (safety 3) #-allegro (debug 3)))
 
-(format t "Evaluating asdf/test/script-support~%")
+;;(format t "Evaluating asdf/test/script-support~%")
 
 ;; We can't use asdf:merge-pathnames* because ASDF isn't loaded yet.
 ;; We still want to work despite and host/device funkiness.
@@ -61,13 +61,7 @@
     #-(or clozure cmu sbcl scl) (namestring p)))
 
 ;;; code adapted from cl-launch http://www.cliki.net/cl-launch
-(defun leave-lisp (message return)
-  (fresh-line *error-output*)
-  (when message
-    (format *error-output* message)
-    (terpri *error-output*))
-  (finish-output *error-output*)
-  (finish-output *standard-output*)
+(defun exit-lisp (return)
   #+allegro
   (excl:exit return)
   #+clisp
@@ -82,12 +76,23 @@
   (lispworks:quit :status return :confirm nil :return nil :ignore-errors-p t)
   #+(or openmcl mcl)
   (ccl::quit return)
-  #+sbcl
-  (sb-ext:quit :unix-status return)
+  #+sbcl #.(let ((exit (find-symbol "EXIT" :sb-ext))
+                 (quit (find-symbol "QUIT" :sb-ext)))
+             (cond
+               (exit `(,exit :code return :abort t))
+               (quit `(,quit :unix-status return :recklessly-p t))))
   #+(or abcl xcl)
   (ext:quit :status return)
   (error "Don't know how to quit Lisp; wanting to use exit code ~a" return))
 
+(defun leave-lisp (message return)
+  (fresh-line *error-output*)
+  (when message
+    (format *error-output* message)
+    (terpri *error-output*))
+  (finish-output *error-output*)
+  (finish-output *standard-output*)
+  (exit-lisp return))
 
 (defmacro quit-on-error (&body body)
   `(call-quitting-on-error (lambda () ,@body)))
-- 
GitLab