From 357f96d661c51ffb547eeb85b89a76c79d6f908d Mon Sep 17 00:00:00 2001
From: Gary King <gwking@metabang.com>
Date: Sun, 29 Jun 2008 15:10:16 +0000
Subject: [PATCH] Applied Matthew Swank's patch to move the "try-recompiling"
 patch from the keyword package into ASDF (where it belongs!). Also added a
 new test to exercise the restart and make sure it is what it claims to be.

---
 asdf.lisp                          |  9 +++++----
 test/run-tests.sh                  | 14 ++++++++++++--
 test/test-try-recompiling-1.script | 29 +++++++++++++++++++++++++++++
 test/try-recompiling-1.asd         |  4 ++++
 test/try-recompiling-1.lisp        |  7 +++++++
 5 files changed, 57 insertions(+), 6 deletions(-)
 create mode 100644 test/test-try-recompiling-1.script
 create mode 100644 test/try-recompiling-1.asd
 create mode 100644 test/try-recompiling-1.lisp

diff --git a/asdf.lisp b/asdf.lisp
index 1f4e1133..4c3b982f 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  $Revision: 1.121 $
+;;; This is asdf: Another System Definition Facility.  $Revision: 1.122 $
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -101,6 +101,7 @@
            #:circular-dependency        ; errors
            #:duplicate-names
 
+	   #:try-recompiling
            #:retry
            #:accept                     ; restarts
 	   )
@@ -118,7 +119,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "$Revision: 1.121 $")
+(defvar *asdf-revision* (let* ((v "$Revision: 1.122 $")
                                (colon (or (position #\: v) -1))
                                (dot (position #\. v)))
                           (and v colon dot
@@ -854,7 +855,7 @@ the head of the tree"))
 	    (perform (make-instance 'asdf:compile-op) c))
 	   (t
 	    (with-simple-restart 
-		(:try-recompiling "Recompile ~a and try loading it again"
+		(try-recompiling "Recompile ~a and try loading it again"
 				  (component-name c))
 	      (setf state :failed-load)
 	      (call-next-method)
@@ -874,7 +875,7 @@ the head of the tree"))
 	    (perform (make-instance 'asdf:compile-op) c))
 	   (t
 	    (with-simple-restart 
-		(:try-recompiling "Try recompiling ~a"
+		(try-recompiling "Try recompiling ~a"
 				  (component-name c))
 	      (setf state :failed-compile)
 	      (call-next-method)
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 231c1292..59fa14cc 100644
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -6,10 +6,20 @@
 # - quit with exit status >0 if an unhandled error occurs
 
 
+if [ x"$1" = "xhelp" ]; then
+    echo "$0 [lisp invocation] [scripts-regex]"
+    echo " - read lisp forms one at a time from matching scripts"
+    echo " - quit with exit status 0 on getting eof"
+    echo " - quit with exit status >0 if an unhandled error occurs"
+    echo " you need to supply the .script in the second argument"
+    echo " lisps include sbcl, clisp, allegro and allegromodern"
+    exit -1
+fi
+
 if [ -z "$2" ]; then
     scripts="*.script"
 else
-    scripts="$2"
+    scripts="$2.script"
 fi
 
 sok=1
@@ -27,7 +37,7 @@ if [ $? -eq 0 ] ; then
       echo "Testing: $i" >&2
       test_count=`expr "$test_count" + 1`
       rm *.$2 || true
-      if $1 < $i ;then
+      if  $1 < $i ; then
         echo "Using $1, $i passed" >&2
 	test_pass=`expr "$test_pass" + 1`
       else
diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script
new file mode 100644
index 00000000..e6630cc3
--- /dev/null
+++ b/test/test-try-recompiling-1.script
@@ -0,0 +1,29 @@
+;;; -*- Lisp -*-
+
+;;; test asdf:try-recompiling restart
+
+(load "script-support")
+(load "../asdf")
+(exit-on-error 
+ (asdf:run-shell-command "rm -f ~A"
+			 (namestring 
+			  (compile-file-pathname "try-recompiling-1")))
+ (defvar *caught-error* nil)
+ (setf asdf:*central-registry* '(*default-pathname-defaults*))
+ (handler-bind ((error (lambda (c) 
+			 (setf *caught-error* t)
+			 (multiple-value-bind (name mode)
+			     (find-symbol
+			      (symbol-name 'try-recompiling)
+			      :asdf)
+			   (assert (eq mode :external))
+			   (let ((restart (find-restart name c)))
+			     #+(or)
+			     ;; debug
+			     (print (list c restart (compute-restarts c)))
+			     (when restart
+			       (invoke-restart restart)))))))
+   (asdf:oos 'asdf:load-op 'try-recompiling-1))
+ (assert *caught-error*)
+ )
+
diff --git a/test/try-recompiling-1.asd b/test/try-recompiling-1.asd
new file mode 100644
index 00000000..ed2d2ecf
--- /dev/null
+++ b/test/try-recompiling-1.asd
@@ -0,0 +1,4 @@
+;;; -*- Lisp -*-
+(asdf:defsystem try-recompiling-1
+    :components ((:file "try-recompiling-1")))
+
diff --git a/test/try-recompiling-1.lisp b/test/try-recompiling-1.lisp
new file mode 100644
index 00000000..8f754c02
--- /dev/null
+++ b/test/try-recompiling-1.lisp
@@ -0,0 +1,7 @@
+(in-package #:common-lisp-user)
+
+(defun try-recompiling-1 ()
+  (assert *caught-error*))
+
+(try-recompiling-1)
+
-- 
GitLab