r5547: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Sat, 23 Aug 2003 12:56:29 +0000 (12:56 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Sat, 23 Aug 2003 12:56:29 +0000 (12:56 +0000)
debian/changelog
src.lisp

index 6d3fbec..eb59076 100644 (file)
@@ -1,3 +1,9 @@
+cl-ptester (2.1-1) unstable; urgency=low
+
+  * Add control of GC reporting for cmu
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sat, 23 Aug 2003 06:47:58 -0600
+
 cl-ptester (2.0-1) unstable; urgency=low
 
   * Rename Debian package
index ac3ffb2..abf57be 100644 (file)
--- 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)