X-Git-Url: http://git.kpe.io/?p=ptester.git;a=blobdiff_plain;f=src.lisp;h=abf57be812dbd32e6345d898ba49ee1844ad85ff;hp=3c197bfa347a5132170c90e6d07fb93bf8b11224;hb=45b3bba13b63386820425c38f6298a06d69b3d5e;hpb=20825c7e1b5f0a878f77a28c1a77d25bfb6c114f

diff --git a/src.lisp b/src.lisp
index 3c197bf..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.1 2003/07/20 18:10:22 kevin Exp $
+;; $Id: src.lisp,v 1.4 2003/08/23 12:56:29 kevin Exp $
 
 (defpackage #:ptester
   (:use #:cl)
@@ -204,6 +204,7 @@ discriminate on new versus known failures."
     ,@(when wanted-message-given `(:wanted-message ,wanted-message))
     ,@(when got-message-given `(:got-message ,got-message))))
 
+(defgeneric conditionp (thing) )
 (defmethod conditionp ((thing condition)) t)
 (defmethod conditionp ((thing t)) nil)
 
@@ -566,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)