X-Git-Url: http://git.kpe.io/?p=ptester.git;a=blobdiff_plain;f=src.lisp;fp=src.lisp;h=abf57be812dbd32e6345d898ba49ee1844ad85ff;hp=ac3ffb20e0cfde24d0eb9920a2a220cd3e77bb5b;hb=45b3bba13b63386820425c38f6298a06d69b3d5e;hpb=ea3a5ef8b91e5c4796e49ef7d59cf3c3e7dda23b diff --git a/src.lisp b/src.lisp index ac3ffb2..abf57be 100644 --- a/src.lisp +++ b/src.lisp @@ -27,7 +27,7 @@ ;;;; from the original ACL 6.1 sources: ;; Id: tester.cl,v 2.2.12.1 2001/06/05 18:45:10 layer Exp -;; $Id: src.lisp,v 1.3 2003/07/20 19:00:44 kevin Exp $ +;; $Id: src.lisp,v 1.4 2003/08/23 12:56:29 kevin Exp $ (defpackage #:ptester (:use #:cl) @@ -567,23 +567,24 @@ Reason: the format-arguments were incorrect.~%") "~ ~&Test ~a aborted by signalling an uncaught error:~%~a~%" ,g-name c)))) - #+allegro - (let ((state (sys:gsgc-switch :print))) - (setf (sys:gsgc-switch :print) nil) + (let ((state (gc-print-state))) + (setf (gc-print-state) nil) (format t "~&**********************************~%") (format t "End ~a test~%" ,g-name) (format t "Errors detected in this test: ~s " *test-errors*) (unless (zerop *test-unexpected-failures*) (format t "UNEXPECTED: ~s" *test-unexpected-failures*)) (format t "~%Successes this test:~s~%" *test-successes*) - (setf (sys:gsgc-switch :print) state)) - #-allegro - (progn - (format t "~&**********************************~%") - (format t "End ~a test~%" ,g-name) - (format t "Errors detected in this test: ~D " *test-errors*) - (unless (zerop *test-unexpected-failures*) - (format t "UNEXPECTED: ~D" *test-unexpected-failures*)) - (format t "~%Successes this test:~D~%" *test-successes*)))))) + (setf (gc-print-state) state)))))) + +(defun gc-print-state () + #+cmu ext:*gc-verbose* + #+allegro (sys:gsgc-switch :print) + ) + +(defun (setf gc-print-state) (state) + #+cmu (setf ext:*gc-verbose* state) + #+allegro (setf (sys:gsgc-switch :print) state) + ) (provide :tester #+module-versions 1.1)