Skip to content
Snippets Groups Projects
Commit dd6bdf52 authored by Karsten Poeck's avatar Karsten Poeck
Browse files

Ext:quit with 0 if not new errors, Ext:quit 1 if new errors

parent 37f0b509
No related branches found
No related tags found
No related merge requests found
......@@ -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
)
)
......
......@@ -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)))))))
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment