Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -436,11 +436,12 @@
;; need to update the top test record if PASS or FAIL and this is a subtest
;; NO NEED TO CALL roll-up-pass-fail-counts HERE, THIS IS DONE IN roll-up-pass-fail-counts called by tests:test-set-status!
))
;; for automated creation of the rollup html file this is a good place...
(if (not (equal? item-path ""))
- (tests:summarize-items run-id test-id test-name #f))) ;; don't force - just update if no
+ (tests:summarize-items run-id test-id test-name #f))
+ (tests:summarize-test run-id test-id)) ;; don't force - just update if no
(mutex-unlock! m)
(debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area "
work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
(if (not (vector-ref exit-info 1))
(exit 4)))))))
Index: tests.scm
==================================================================
--- tests.scm
+++ tests.scm
@@ -392,19 +392,24 @@
(tests:test-set-toplog! run-id test-name outputfilename)
)))))))
;; summarize test
(define (tests:summarize-test run-id test-id)
- (let ((test-dat (rmt:get-test-info-by-id run-id test-id))
- (steps-dat (rmt:get-steps-for-test run-id test-id))
- (test-name (db:test-get-testname test-dat)))
- (with-output-to-file "test-summary.html"
- (lambda ()
- (print "Summary: " test-name
- "Summary for " test-name "
")
- (print "
-
+ (let* ((test-dat (rmt:get-test-info-by-id run-id test-id))
+ (steps-dat (rmt:get-steps-for-test run-id test-id))
+ (test-name (db:test-get-testname test-dat))
+ (oup (open-output-file "test-summary.html")))
+ (s:output-new
+ oup
+ (s:html
+ (s:title "Summary: " test-name)
+ (s:body
+ (s:h2 "Summary for " test-name)
+ )))
+ (close-output-port oup)))
+
+
;; MUST BE CALLED local!
;;
(define (tests:test-get-paths-matching keynames target fnamepatt #!key (res '()))
;; BUG: Move the values derived from args to parameters and push to megatest.scm
(let* ((testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))