Permalink
Browse files

include test time in HTML report

include test time in HTML report; In AllegroCL, use internal features
to get fractional seconds.
  • Loading branch information...
1 parent 0f40078 commit ea6e904f662101cd7a4b0ed416fceb046a0a8939 @gwkkwg committed Mar 19, 2013
Showing with 68 additions and 23 deletions.
  1. +2 −2 .gitignore
  2. +1 −1 dev/class-defs.lisp
  3. +4 −4 dev/lift.lisp
  4. +4 −4 dev/macros.lisp
  5. +14 −0 dev/port.lisp
  6. +7 −3 dev/reports.lisp
  7. +1 −1 dev/test-runner.lisp
  8. +25 −8 dev/utilities.lisp
  9. +10 −0 resources/test-style.css
View
@@ -17,5 +17,5 @@ lift-local.config
benchmark-data/
# new ASDF stuff
-*.*-warnings
-*.build-report
+#*.*-warnings
+#*.build-report
View
@@ -69,7 +69,7 @@
LIFT during a test run.")
(:default-initargs
:test-interactive? *test-is-being-defined?*
- :real-start-time (get-internal-real-time)
+ :real-start-time (get-test-real-time)
:real-start-time-universal (get-universal-time)))
(defclass test-problem-mixin ()
View
@@ -209,7 +209,7 @@
(defmethod testsuite-teardown :after
((testsuite test-mixin) (result test-result))
(setf (current-step result) :testsuite-teardown
- (real-end-time result) (get-internal-real-time)
+ (real-end-time result) (get-test-real-time)
(real-end-time-universal result) (get-universal-time)))
;;;;
@@ -895,13 +895,13 @@ Test options are one of :setup, :teardown, :test, :tests, :documentation, :expor
(defun record-start-times (result suite)
(setf (current-step result) :start-test
(test-data suite)
- `(:start-time ,(get-internal-real-time)
+ `(:start-time ,(get-test-real-time)
:start-time-universal ,(get-universal-time))))
(defun record-end-times (result suite)
(setf (current-step result) :end-test
- (getf (test-data suite) :end-time) (get-internal-real-time)
- (end-time result) (get-internal-real-time)
+ (getf (test-data suite) :end-time) (get-test-real-time)
+ (end-time result) (get-test-real-time)
(getf (test-data suite) :end-time-universal) (get-universal-time)
(end-time-universal result) (get-universal-time)))
View
@@ -186,10 +186,10 @@ therefore assumes that `body` executes quickly relative to delay."
'(lambda ()
(let* ((,gevent-count 0)
(,gdelay (truncate (* ,delay internal-time-units-per-second)))
- (,gstart (get-internal-real-time))
+ (,gstart (get-test-real-time))
(,gend (+ ,gstart ,gdelay)))
(declare (type fixnum ,gevent-count))
- (loop while (< (get-internal-real-time) ,gend) do
+ (loop while (< (get-test-real-time) ,gend) do
(progn ,@body)
(setf ,gevent-count (the fixnum (1+ ,gevent-count))))
(let ((,gduration (/ (- ,gend ,gstart)
@@ -235,11 +235,11 @@ therefore assumes that `body` executes quickly relative to delay."
`(let* ((,gfn (lambda ()
(let* ((,gevent-count 0)
(,gdelay (truncate (* ,delay internal-time-units-per-second)))
- (,gstart (get-internal-real-time))
+ (,gstart (get-test-real-time))
(,gend (+ ,gstart ,gdelay)))
(declare (type fixnum ,gevent-count))
(flet ((did-event () (incf ,gevent-count)))
- (loop while (< (get-internal-real-time) ,gend) do
+ (loop while (< (get-test-real-time) ,gend) do
(progn ,@body)))
(let ((,gduration (float (/ (- ,gend ,gstart)
internal-time-units-per-second))))
View
@@ -224,3 +224,17 @@ returns a string with the corresponding backtrace.")
destination)
(declare (ignorable name style fn body log-name count-calls-p timeout destination))
(funcall fn))
+
+#+allegro
+(eval-when (compile eval)
+ (require :timedefs))
+
+#+allegro
+(defun get-test-real-time ()
+ (multiple-value-bind (secs fsecs)
+ (excl::cl-internal-real-time)
+ (+ (* (+ secs #.excl::seconds-1900-2015) 1000) fsecs)))
+
+#-allegro
+(defun get-test-real-time ()
+ (* 1000 (get-universal-time)))
View
@@ -448,7 +448,11 @@ lift::(progn
(defmethod report-test-case-by-suite
((format (eql :html)) stream suite test-name datum)
(format stream "~&<div class=\"test-case\">")
- (let ((problem (getf datum :problem)))
+ (let ((problem (getf datum :problem))
+ (start (getf datum :start-time)))
+ (when start
+ (format stream "<span class=\"start-time\">~a</span>"
+ (format-test-time-for-log start)))
(cond ((typep problem 'test-failure)
(format stream "~&<span class=\"test-name\"><a href=\"~a\" title=\"details\">~a</a></span>"
(details-link suite test-name)
@@ -796,7 +800,7 @@ lift::(progn
(format out-stream "~&\(~%")
(out :suite (encode-symbol suite-name))
(out :name (encode-symbol test-case-name))
- (out :start-time-universal (get-universal-time)))))
+ (out :start-time (get-test-real-time)))))
(defmethod write-log-test-end
((format (eql :save)) suite-name test-case-name data
@@ -808,7 +812,7 @@ lift::(progn
(let* ((key (form-keyword name))
(value (getf source key)))
(out key value))))
- (write-datum 'end-time-universal)
+ (write-datum 'end-time)
(write-datum 'result)
(write-datum 'seconds)
(write-datum 'conses)
View
@@ -217,7 +217,7 @@ nor configuration file options were specified.")))))
(skip-testsuite result suite-name))
(t
(unless (start-time result)
- (setf (start-time result) (get-internal-real-time)
+ (setf (start-time result) (get-test-real-time)
(start-time-universal result) (get-universal-time)))
(unwind-protect
(loop for method in methods do
View
@@ -122,6 +122,7 @@ pathspac points. For example:
(error "Unable to find unique pathname for ~a" pathname))))
(defun date-stamp (&key (datetime (get-universal-time)) (include-time? nil)
+ (include-date? t)
(time-delimiter #\-) (date-delimiter #\-) (date-time-separator #\T))
(multiple-value-bind
(second minute hour day month year day-of-the-week)
@@ -130,14 +131,30 @@ pathspac points. For example:
(let ((date-part (format nil "~d~@[~c~]~2,'0d~@[~c~]~2,'0d"
year date-delimiter month date-delimiter day))
(time-part (and include-time?
- (list (format nil "~@[~c~]~2,'0d~@[~c~]~2,'0d~@[~c~]~2,'0d"
- date-time-separator hour
- time-delimiter minute
- time-delimiter second)))))
- (if time-part
- (apply 'concatenate 'string date-part time-part)
- date-part))))
-
+ (format nil "~2,'0d~@[~c~]~2,'0d~@[~c~]~2,'0d"
+ hour time-delimiter minute
+ time-delimiter second))))
+ (format nil "~@[~a~]~@[~c~]~@[~a~]"
+ (and include-date? date-part)
+ (and include-date? include-time? date-time-separator)
+ (and include-time? time-part)))))
+
+#-allegro
+(defun format-test-time-for-log (test-time)
+ (multiple-value-bind (ut fsecs)
+ (truncate test-time 1000)
+ (date-stamp :datetime ut :include-date? nil :include-time? t :time-delimiter #\:)))
+
+#+allegro
+(defun format-test-time-for-log (test-time)
+ (multiple-value-bind (ut fsecs)
+ (truncate test-time 1000)
+ (with-output-to-string (out)
+ (let* ((time
+ (excl:locale-print-time ut :fmt "%T" :stream nil)
+ #+no
+ (excl:locale-print-time ut :fmt "%Y-%m-%dT%T" :stream nil)))
+ (format out "~a.~3,'0d" time fsecs)))))
#+(or)
(date-stamp :include-time? t)
View
@@ -142,6 +142,16 @@ h3 {
width: 35px;
}
+.start-time {
+ float: left;
+ padding-left: 20px;
+ padding-right: 20px;
+ text-align: right;
+ display: run-in;
+// width: 35px;
+}
+
+
.test-space {
padding-left: 20px;
text-align: right;

0 comments on commit ea6e904

Please sign in to comment.