Permalink
Browse files

Cleanup, minor fixes

* correct several warnings that SBCL catches

* move more platform specific into port.lisp

* correct bug in `print-tests` (reported by JBThiel)
  • Loading branch information...
1 parent 2b6f910 commit eff20a8974c99ec80f25fede19329649a34b163d Gary King committed Jan 16, 2012
Showing with 725 additions and 71 deletions.
  1. +1 −0 dev/config.lisp
  2. +5 −0 dev/definitions.lisp
  3. +29 −0 dev/generics.lisp
  4. +1 −1 dev/introspection.lisp
  5. +2 −4 dev/lift.lisp
  6. +2 −1 dev/macros.lisp
  7. +2 −5 dev/measuring.lisp
  8. +64 −0 dev/port.lisp
  9. +2 −52 dev/reports.lisp
  10. +6 −8 lift.asd
  11. +207 −0 website/source/user-guide.css
  12. +404 −0 website/source/user-guide.md
View
@@ -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)
View
@@ -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)
+
View
@@ -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))
View
@@ -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
View
@@ -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))
View
@@ -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)))
View
@@ -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)
View
@@ -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))
View
@@ -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
View
@@ -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"
Oops, something went wrong.

0 comments on commit eff20a8

Please sign in to comment.