Commit 357f96d6 authored by Gary King's avatar Gary King
Browse files

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.
parent 2f2360f3
;;; 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 ;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical ;;; <cclan-list@lists.sf.net>. But note first that the canonical
...@@ -101,6 +101,7 @@ ...@@ -101,6 +101,7 @@
#:circular-dependency ; errors #:circular-dependency ; errors
#:duplicate-names #:duplicate-names
#:try-recompiling
#:retry #:retry
#:accept ; restarts #:accept ; restarts
) )
...@@ -118,7 +119,7 @@ ...@@ -118,7 +119,7 @@
(in-package #:asdf) (in-package #:asdf)
(defvar *asdf-revision* (let* ((v "$Revision: 1.121 $") (defvar *asdf-revision* (let* ((v "$Revision: 1.122 $")
(colon (or (position #\: v) -1)) (colon (or (position #\: v) -1))
(dot (position #\. v))) (dot (position #\. v)))
(and v colon dot (and v colon dot
...@@ -854,7 +855,7 @@ the head of the tree")) ...@@ -854,7 +855,7 @@ the head of the tree"))
(perform (make-instance 'asdf:compile-op) c)) (perform (make-instance 'asdf:compile-op) c))
(t (t
(with-simple-restart (with-simple-restart
(:try-recompiling "Recompile ~a and try loading it again" (try-recompiling "Recompile ~a and try loading it again"
(component-name c)) (component-name c))
(setf state :failed-load) (setf state :failed-load)
(call-next-method) (call-next-method)
...@@ -874,7 +875,7 @@ the head of the tree")) ...@@ -874,7 +875,7 @@ the head of the tree"))
(perform (make-instance 'asdf:compile-op) c)) (perform (make-instance 'asdf:compile-op) c))
(t (t
(with-simple-restart (with-simple-restart
(:try-recompiling "Try recompiling ~a" (try-recompiling "Try recompiling ~a"
(component-name c)) (component-name c))
(setf state :failed-compile) (setf state :failed-compile)
(call-next-method) (call-next-method)
......
...@@ -6,10 +6,20 @@ ...@@ -6,10 +6,20 @@
# - quit with exit status >0 if an unhandled error occurs # - 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 if [ -z "$2" ]; then
scripts="*.script" scripts="*.script"
else else
scripts="$2" scripts="$2.script"
fi fi
sok=1 sok=1
...@@ -27,7 +37,7 @@ if [ $? -eq 0 ] ; then ...@@ -27,7 +37,7 @@ if [ $? -eq 0 ] ; then
echo "Testing: $i" >&2 echo "Testing: $i" >&2
test_count=`expr "$test_count" + 1` test_count=`expr "$test_count" + 1`
rm *.$2 || true rm *.$2 || true
if $1 < $i ;then if $1 < $i ; then
echo "Using $1, $i passed" >&2 echo "Using $1, $i passed" >&2
test_pass=`expr "$test_pass" + 1` test_pass=`expr "$test_pass" + 1`
else else
......
;;; -*- 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*)
)
;;; -*- Lisp -*-
(asdf:defsystem try-recompiling-1
:components ((:file "try-recompiling-1")))
(in-package #:common-lisp-user)
(defun try-recompiling-1 ()
(assert *caught-error*))
(try-recompiling-1)
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