diff --git a/clasp/clasp-expected-failures.lisp b/clasp/clasp-expected-failures.lisp index e9d2c2d6765c6900ca6fb007ff5f8519d76bd044..b02f36aa439d0af9a5d7644d17ff9887f5176aab 100644 --- a/clasp/clasp-expected-failures.lisp +++ b/clasp/clasp-expected-failures.lisp @@ -145,14 +145,14 @@ LW 2021-11-13 7.1.2 286 out of 21814 total tests failed: CLEAR-INPUT.2 CLEAR-INPUT.3 CLEAR-INPUT.4 - ARRAY.3.1 - ARRAY.3.2 - ARRAY.5.2 - ARRAY.7.3 - ARRAY.9.7 - ARRAY.9.8 - ARRAY.9.10 - ARRAY.9.12 + ;;; ARRAY.3.1 + ;;; ARRAY.3.2 + ;;; ARRAY.5.2 + ;;; ARRAY.7.3 + ;;; ARRAY.9.7 + ;;; ARRAY.9.8 + ;;; ARRAY.9.10 + ;;; ARRAY.9.12 ) ) diff --git a/doit-clasp.lsp b/doit-clasp.lsp index a1a7b799df0033dbbc78e47be1970746371d9841..5f499c38ee3bacc1600891e30c122ec77203116e 100644 --- a/doit-clasp.lsp +++ b/doit-clasp.lsp @@ -148,13 +148,17 @@ #-:ansi-dont-start (progn - (time - (let ((*package* (find-package :cl-test))) - (regression-test:do-tests) - (regression-test:analyse-tests)))) - -#-:ansi-dont-quit -(progn - #+allegro (cl-user::exit) - #+(or cmu sbcl gcl armedbear clisp CLOZURE-COMMON-LISP ecl) (cl-user::quit) - #+clasp (ext:quit)) + (let ((*package* (find-package :cl-test))) + (multiple-value-bind (no-errors-p no-unexpected-errors-p) + (regression-test:do-tests) + (regression-test:analyse-tests) + #-:ansi-dont-quit + (progn + #+allegro (cl-user::exit) + #+(or cmu sbcl gcl armedbear clisp CLOZURE-COMMON-LISP ecl) (cl-user::quit) + #+clasp + (let ((success (or no-errors-p no-unexpected-errors-p))) + (format t "Success: ~a No Errors: ~a No unexpected: ~a ~%" success no-errors-p no-unexpected-errors-p) + (if success + (ext:quit 0) + (ext:quit 1))))))) diff --git a/rt.lsp b/rt.lsp index 83b71d681ccf49fc0d3787a9ac8225f308a3354c..4105480c1f2810abd2f34f51d7d741aeca623654 100644 --- a/rt.lsp +++ b/rt.lsp @@ -457,69 +457,68 @@ (length (cdr *entries*))) (finish-output s) (let ((index 0)) - (when *compile-tests* - (compile-entries s (cdr *entries*))) - (dolist (entry (cdr *entries*)) - (when (and (pend entry) - (not (has-disabled-note entry))) - (let ((success? (do-entry entry s))) - #+no - (unless (typep (handler-case (PACKAGE-ERROR-PACKAGE (MAKE-CONDITION 'PACKAGE-ERROR :PACKAGE #\A) NIL)(error (e) e)) 'error) - (error "broke")) - (if success? - (push (name entry) *passed-tests*) - (push (name entry) *failed-tests*)) - (format s "~@[~<~%~:; ~:@(~S~)~>~]" success?)) - (finish-output s) - (incf index) - (when (zerop (mod index 50)) - (print `(,index :of ,(length (cdr *entries*)))) - (terpri)) - ))) + (when *compile-tests* + (compile-entries s (cdr *entries*))) + (dolist (entry (cdr *entries*)) + (when (and (pend entry) + (not (has-disabled-note entry))) + (let ((success? (do-entry entry s))) + (if success? + (push (name entry) *passed-tests*) + (push (name entry) *failed-tests*)) + (format s "~@[~<~%~:; ~:@(~S~)~>~]" success?)) + (finish-output s) + (incf index) + (when (zerop (mod index 50)) + (print `(,index :of ,(length (cdr *entries*)))) + (terpri)) + ))) (let ((pending (pending-tests)) (expected-table (make-hash-table :test #'equal))) (dolist (ex *expected-failures*) (setf (gethash ex expected-table) t)) (let ((new-failures - (loop for pend in pending - unless (gethash pend expected-table) - collect pend))) + (loop for pend in pending + unless (gethash pend expected-table) + collect pend))) (if (null pending) (format s "~&No tests failed.") - (progn - (format t "~&~A out of ~A total tests failed: ~%(~{~a~^~%~})" - (length pending) - (length (cdr *entries*)) - pending) - (if (null new-failures) - (format s "~&No unexpected failures.") - (when *expected-failures* - (setf *unexpected-failures* new-failures) - (format s "~&~A unexpected failures: ~ + (progn + (format t "~&~A out of ~A total tests failed: ~%(~{~a~^~%~})" + (length pending) + (length (cdr *entries*)) + pending) + #+(or) + (format t "~&New failures: ~%(~{~a~^~%~})" new-failures) + (if (null new-failures) + (format s "~&No unexpected failures.") + (progn + (setf *unexpected-failures* new-failures) + (format s "~&~A unexpected failures: ~ ~:@(~{~<~% ~1:;~S~>~ ~^, ~}~)." - (length new-failures) - new-failures))) - (when *expected-failures* - (let ((pending-table (make-hash-table :test #'equal))) - (dolist (ex pending) - (setf (gethash ex pending-table) t)) - (let ((unexpected-successes - (loop :for ex :in *expected-failures* - :unless (gethash ex pending-table) :collect ex))) - (if unexpected-successes - (progn - (setf *unexpected-successes* unexpected-successes) - (format t "~&~:D unexpected successes: ~ + (length new-failures) + new-failures))) + (when *expected-failures* + (let ((pending-table (make-hash-table :test #'equal))) + (dolist (ex pending) + (setf (gethash ex pending-table) t)) + (let ((unexpected-successes + (loop :for ex :in *expected-failures* + :unless (gethash ex pending-table) :collect ex))) + (if unexpected-successes + (progn + (setf *unexpected-successes* unexpected-successes) + (format t "~&~:D unexpected successes: ~ ~:@(~{~<~% ~1:;~S~>~ ~^, ~}~)." - (length unexpected-successes) - unexpected-successes)) - (format t "~&No unexpected successes."))))) - )) + (length unexpected-successes) + unexpected-successes)) + (format t "~&No unexpected successes."))))) + )) (finish-output s) (terpri) - (null pending)))) + (values (null pending) (null *unexpected-failures*))))) ;;; Note handling functions and macros