(dolist (file files)
(when (accept-test-file file)
(format t "// Running ~a~%" file)
- (handler-case
- (funcall test-fun file)
- (error (error)
- (push (list :unhandled-error file)
- *all-failures*)
- (when *break-on-error*
- (test-util:really-invoke-debugger error))))))
+ (restart-case
+ (handler-bind ((error (make-error-handler file)))
+ (funcall test-fun file))
+ (skip-file ()))))
(append-failures)))
(defun impure-runner (files test-fun)
(let ((pid (sb-posix:fork)))
(cond ((= pid 0)
(format t "// Running ~a~%" file)
- (handler-case
- (funcall test-fun file)
- (error (error)
- (push (list :unhandled-error file) *failures*)
- (when *break-on-error*
- (test-util:really-invoke-debugger error))))
+ (restart-case
+ (handler-bind ((error (make-error-handler file)))
+ (funcall test-fun file))
+ (skip-file ()
+ (format t ">>>~a<<<~%" *failures*)))
(report-test-status)
(sb-ext:quit :unix-status 104))
(t
(push (list :invalid-exit-status file)
*all-failures*))))))))))
+(defun make-error-handler (file)
+ (lambda (condition)
+ (push (list :unhandled-error file) *failures*)
+ (cond (*break-on-error*
+ (test-util:really-invoke-debugger condition))
+ (t
+ (format *error-output* "~&Unhandled ~a: ~a~%"
+ (type-of condition) condition)
+ (sb-debug:backtrace)))
+ (invoke-restart 'skip-file)))
+
(defun append-failures (&optional (failures *failures*))
(setf *all-failures* (append failures *all-failures*)))
(defun unexpected-failures ()
- (remove-if (lambda (x)
- (or (eq (car x) :expected-failure)
- (eq (car x) :unexpected-success)))
+ (remove-if (lambda (x)
+ (or (eq (car x) :expected-failure)
+ (eq (car x) :unexpected-success)))
*all-failures*))
(defun setup-cl-user ()