;;;; 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$
(defpackage #:ptester
(:use #:cl)
"~
~&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)