Cleanup, minor fixes

* correct several warnings that SBCL catches

* move more platform specific into port.lisp

* correct bug in `print-tests` (reported by JBThiel)

dev/config.lisp

@@ -150,6 +150,7 @@ use asdf:test-op or bind *current-asdf-system-name* yourself."))))))
 	   (tagbody 
 	      (flet ((stop-running-tests ()
 		       (setf run-tests-p nil)))
+		(declare (ignorable (function stop-running-tests)))
 		#+allegro
 		(excl:set-signal-handler excl::*sigterm*
 				    (lambda (a b)

dev/definitions.lisp

@@ -170,3 +170,8 @@ the thing being defined.")
 
 (defvar *profile-style* nil
   "Sets the default profiling style to :time, :space, or nil (for no profiling).")
+
+(defvar *functions-to-profile* nil)
+
+(defvar *profiling-threshold* nil)
+

dev/generics.lisp

@@ -59,3 +59,32 @@ the methods that should be run to do the tests for this testsuite."))
   (:method ((name t) (value t))
            (error "Unknown clause: ~A" name)))
 
+(defgeneric accumulate-problem (problem result))
+
+(defgeneric make-test-result (for test-mode &rest args))
+
+(defgeneric print-test-problem (prefix report stream show-code-p))
+
+(defgeneric testsuite-log-data (suite))
+
+(defgeneric problem-summarization (problem))
+
+(defgeneric report-test-suite-by-suite (format stream remaining current-suite suite))
+
+(defgeneric report-test-case-by-suite (format stream suite test-name datum))
+
+(defgeneric finish-report-tests-by-suite (format stream current-suite))
+
+(defgeneric write-log-test-start (format suite-name test-case-name &key stream))
+
+(defgeneric write-log-test-end (format suite-name test-case-name data &key stream))
+
+(defgeneric brief-problem-output (glitch))
+
+(defgeneric save-configuration-file (result destination))
+
+(defgeneric result-summary-tag (problem style))
+
+(defgeneric test-case-count (testsuite))
+
+(defgeneric do-testing (suite result fn))

dev/introspection.lisp

@@ -151,7 +151,7 @@ control over where in the test hierarchy the search begins."
    (lambda (suite level)
      (let ((indent (coerce (make-list (* level 3) :initial-element #\Space)
 			   'string))
-	   (name (class-name suite)))
+	   (name suite))
        (format stream "~&~a~s (~:d)" 
 	       indent
 	       name

dev/lift.lisp

@@ -299,6 +299,7 @@
 
 (defmethod initialize-instance :after ((testsuite test-mixin) &rest initargs 
 				       &key &allow-other-keys)
+  (declare (ignorable initargs))
   (when (null (testsuite-name testsuite))
     (setf (slot-value testsuite 'name) 
 	  (symbol-name (type-of testsuite)))))
@@ -593,10 +594,7 @@ Test options are one of :setup, :teardown, :test, :tests, :documentation, :expor
 		  ,@(when (def :dynamic-variables)
 			  `((defmethod do-testing :around
 				((suite ,(def :testsuite-name)) result fn) 
-			      (declare (ignore result fn)
-				       (special 
-					,@(mapcar 
-					   #'car (def :dynamic-variables))))
+			      (declare (ignore result fn))
 			      (with-test-slots
 				(cond ((done-dynamics? suite)
 				       (call-next-method))

dev/macros.lisp

@@ -513,7 +513,7 @@ test failure is generated instead of a warning"
 )
 
 (defmacro with-test-slots (&body body)
-  `(symbol-macrolet ((lift-result (getf (test-data *current-test*) :result)))   
+  `(symbol-macrolet ((lift-result `(getf (test-data *current-test*) :result)))   
      ;; case111 - LW complains otherwise
      (declare (ignorable lift-result)
 	      ,@(when (def :dynamic-variables)
@@ -559,6 +559,7 @@ test failure is generated instead of a warning"
 	   (close ,var))))))
 
 (defmacro newlinify (format &environment e)
+  (declare (ignorable e))
   #+allegro
   `(if (and (constantp ,format ,e)
 	   (stringp (sys:constant-value ,format ,e)))

dev/measuring.lisp

@@ -80,10 +80,6 @@ The accuracy can be no greater than {hs internal-time-units-per-second}.")
        (values-list (nconc (list ,seconds ,conses)
 			   ,results)))))
 
-(defvar *functions-to-profile* nil)
-
-(defvar *profiling-threshold* nil)
-
 (defun make-profiled-function (fn)
   (lambda (style count-calls-p)
     (declare (ignorable count-calls-p))
@@ -115,7 +111,7 @@ The accuracy can be no greater than {hs internal-time-units-per-second}.")
 
 (defun generate-profile-log-entry (log-name name seconds conses results error)
   (generate-log-entry name seconds conses :results results :error error
-		      :sample-count (and (plusp (current-profile-sample-count))
+		      :sample-count (and (plusp (the fixnum (current-profile-sample-count)))
 					 (current-profile-sample-count))
 		      :log-name log-name))
 
@@ -129,6 +125,7 @@ The accuracy can be no greater than {hs internal-time-units-per-second}.")
 			  :direction :output
 			  :if-does-not-exist :create
 			  :if-exists :append)
+    (declare (type stream output))
     (with-standard-io-syntax
       (let ((*print-readably* nil))
 	(terpri output)

dev/port.lisp

@@ -160,3 +160,67 @@ returns a string with the corresponding backtrace.")
       (debug:backtrace most-positive-fixnum s))))
 
 
+
+
+
+#+allegro
+(defun cancel-current-profile (&key force?)
+  (when (prof::current-profile-actual prof::*current-profile*)
+    (unless force?
+      (assert (member (prof:profiler-status) '(:inactive))))
+    (prof:stop-profiler)
+    (setf prof::*current-profile* (prof::make-current-profile))))
+
+#+allegro
+(defun current-profile-sample-count ()
+   (ecase (prof::profiler-status :verbose nil)
+    ((:inactive :analyzed) 0)
+    ((:suspended :saved)
+     (slot-value (prof::current-profile-actual prof::*current-profile*) 
+		 'prof::samples))
+    (:sampling (warn "Can't determine count while sampling"))))
+
+#+allegro
+(defun show-flat-profile (output)
+  (let ((prof:*significance-threshold* 
+	 (or *profiling-threshold* prof:*significance-threshold*)))
+    (prof:show-flat-profile :stream output)))
+
+#+allegro
+(defun show-call-graph (output)
+  (let ((prof:*significance-threshold* 
+	 (or *profiling-threshold* prof:*significance-threshold*)))
+    (prof:show-call-graph :stream output)))
+
+#+allegro
+(defun show-call-counts (output)
+  (format output "~%~%Call counts~%")
+  (let ((*standard-output* output))
+    (prof:show-call-counts)))
+
+#-allegro
+(defun current-profile-sample-count ()
+  0)
+
+#-allegro
+(defun show-flat-profile (output)
+  (format output "~%~%Flat profile: unavailable for this Lisp~%"))
+
+#-allegro
+(defun show-call-graph (output)
+  (format output "~%~%Call graph: unavailable for this Lisp~%"))
+
+#-allegro
+(defun show-call-counts (output)
+  (format output "~%~%Call counts: unavailable for this Lisp~%"))
+
+#-allegro
+;; ugh!
+(defun with-profile-report-fn 
+    (name style fn body &key
+     (log-name *log-path*)
+     (count-calls-p *count-calls-p*)
+     (timeout nil)
+     destination)
+  (declare (ignorable name style fn body log-name count-calls-p timeout destination))
+  (funcall fn))

dev/reports.lisp

@@ -783,9 +783,9 @@ lift::(progn
 
 (defmethod write-log-test (format suite-name test-case-name data
 			   &key (stream *standard-output*))
-  (write-log-test-start format suite-name test-case-name data 
+  (write-log-test-start format suite-name test-case-name 
 			:stream stream)
-  (write-log-test-end format suite-name test-case-name
+  (write-log-test-end format suite-name test-case-name data
 			:stream stream))
 
 (defmethod write-log-test-start 
@@ -858,56 +858,6 @@ lift::(progn
 
 ;;;;;
 
-
-
-#+allegro
-(defun cancel-current-profile (&key force?)
-  (when (prof::current-profile-actual prof::*current-profile*)
-    (unless force?
-      (assert (member (prof:profiler-status) '(:inactive))))
-    (prof:stop-profiler)
-    (setf prof::*current-profile* (prof::make-current-profile))))
-
-#+allegro
-(defun current-profile-sample-count ()
-   (ecase (prof::profiler-status :verbose nil)
-    ((:inactive :analyzed) 0)
-    ((:suspended :saved)
-     (slot-value (prof::current-profile-actual prof::*current-profile*) 
-		 'prof::samples))
-    (:sampling (warn "Can't determine count while sampling"))))
-
-#+allegro
-(defun show-flat-profile (output)
-  (let ((prof:*significance-threshold* 
-	 (or *profiling-threshold* prof:*significance-threshold*)))
-    (prof:show-flat-profile :stream output)))
-
-#+allegro
-(defun show-call-graph (output)
-  (let ((prof:*significance-threshold* 
-	 (or *profiling-threshold* prof:*significance-threshold*)))
-    (prof:show-call-graph :stream output)))
-
-#+allegro
-(defun show-call-counts (output)
-  (format output "~%~%Call counts~%")
-  (let ((*standard-output* output))
-    (prof:show-call-counts)))
-
-
-#-allegro
-(defun show-flat-profile (output)
-  (format output "~%~%Flat profile: unavailable for this Lisp~%"))
-
-#-allegro
-(defun show-call-graph (output)
-  (format output "~%~%Call graph: unavailable for this Lisp~%"))
-
-#-allegro
-(defun show-call-counts (output)
-  (format output "~%~%Call counts: unavailable for this Lisp~%"))
-
 #+allegro
 (defun with-profile-report-fn 
     (name style fn body &key

lift.asd

@@ -32,26 +32,24 @@
 		"api"
 		:pathname "dev/"
 		:depends-on ("setup")
-		:components ((:file "generics")))
+		:components ((:file "generics")
+			     (:file "port")))
 	       (:module 
 		"dev" 
 		:depends-on ("setup" "api")
 		:components 
 		((:static-file "notes.text")
 		 (:file "lift"
-			:depends-on ("measuring" "port"))
+			:depends-on ("measuring"))
 		 (:file "copy-file"
 			:depends-on ())
 		 (:file "random-testing" 
 			:depends-on ("lift"))
-		 (:file "port" 
-			:depends-on ())
-		 (:file "measuring" 
-			:depends-on ("port"))
+		 (:file "measuring")
 		 (:file "config" 
-			:depends-on ("port" "lift"))
+			:depends-on ("lift"))
 		 (:file "reports" 
-			:depends-on ("port" "lift" "copy-file"))
+			:depends-on ("lift" "copy-file"))
 		 (:file "introspection" 
 			:depends-on ("lift"))
 		 (:file "test-runner"