(format t "Finished running tests.~%")
(cond (*all-failures*
(format t "Status:~%")
- (dolist (fail (reverse *all-failures*))
+ (dolist (fail (reverse *all-failures*))
(cond ((eq (car fail) :unhandled-error)
(format t " ~20a ~a~%"
"Unhandled error"
(ecase (first fail)
(:expected-failure "Expected failure:")
(:unexpected-failure "Failure:")
- (:unexpected-success "Unexcepted success:"))
+ (:unexpected-success "Unexpected success:"))
(enough-namestring (second fail))
(third fail))))))
(t
(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)
(format t "// Running impure tests (~a)~%" test-fun)
(let ((*package* (find-package :cl-user)))
(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) (eq (car x) :expected-failure)) *all-failures*))
+ (remove-if (lambda (x)
+ (or (eq (car x) :expected-failure)
+ (eq (car x) :unexpected-success)))
+ *all-failures*))
(defun setup-cl-user ()
(use-package :test-util)
(defun sh-test (file)
;; What? No SB-POSIX:EXECV?
- (let ((process (sb-ext:run-program "/bin/sh"
+ (let ((process (sb-ext:run-program "/bin/sh"
(list (namestring file))
- :output *error-output*)))
+ :output *error-output*)))
(sb-ext:quit :unix-status (process-exit-code process))))
(defun accept-test-file (file)