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