Overview
Context
Changes
Modified common.scm
from [cacda34afd]
to [69895b157d].
| ︙ | | |
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
|
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
|
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
-
|
resh))
;; hash-table tree to html list tree
;;
;; tipfunc takes two parameters: y the tip value and path the path to that point
;;
(define (common:htree->html ht path tipfunc)
(let ((datlist (hash-table->alist ht)))
(if (null? datlist)
(tipfunc #f path) ;; really shouldn't get here
(s:ul
(map (lambda (x)
(let ((levelname (car x)))
(s:li
levelname
(let ((y (cdr x))
(newpath (append path (list levelname))))
;; (print "levelname=" levelname " newpath=" newpath)
(if (hash-table? y)
(common:htree->html y newpath tipfunc)
(tipfunc y newpath))))))
(hash-table->alist ht))))
|
| ︙ | | |
Modified tests.scm
from [45e5456322]
to [890366c265].
| ︙ | | |
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
|
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
|
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
</script>
EOF
)
;; (tests:create-html-tree "test-index.html")
;;
(define (tests:create-html-tree outf)
(let* ((lockfile (conc outf ".lock"))
(runs-to-process '()))
(if (common:simple-file-lock (conc outf ".lock"))
(let* ((oup (open-output-file outf))
(area-name (common:get-testsuite-name))
(keys (rmt:get-keys))
(numkeys (length keys))
(runsdat (rmt:get-runs "%" #f #f (map (lambda (x)(list x "%")) keys)))
(header (vector-ref runsdat 0))
(runs (vector-ref runsdat 1))
(runtreedat (map (lambda (x)
(append (take (vector->list x) numkeys)
(list (vector-ref x (+ 1 numkeys))))) ;; gets the runname
runs))
(runs-htree (common:list->htree runtreedat)))
(s:output-new
oup
(s:html tests:css-jscript-block
(s:title "Summary for " area-name)
(s:body 'onload "addEvents();"
;; top list
(s:ul 'id "LinkedList1" 'class "LinkedList"
(s:li
"Runs"
(common:htree->html runs-htree
'()
(lambda (x p)
(apply s:a x p))))))))
(close-output-port oup)
(common:simple-file-release-lock (conc outf ".lock"))
#t)
#f))
(if (common:simple-file-lock lockfile)
(let* ((linktree (common:get-linktree))
(oup (open-output-file outf))
(area-name (common:get-testsuite-name))
(keys (rmt:get-keys))
(numkeys (length keys))
(runsdat (rmt:get-runs "%" #f #f (map (lambda (x)(list x "%")) keys)))
(header (vector-ref runsdat 0))
(runs (vector-ref runsdat 1))
(runtreedat (map (lambda (x)
(append (take (vector->list x) numkeys)
(list (vector-ref x (+ 1 numkeys))))) ;; gets the runname
runs))
(runs-htree (common:list->htree runtreedat)))
(set! runs-to-process runs)
(s:output-new
oup
(s:html tests:css-jscript-block
(s:title "Summary for " area-name)
(s:body 'onload "addEvents();"
(s:h1 "Summary for " area-name)
;; top list
(s:ul 'id "LinkedList1" 'class "LinkedList"
(s:li
"Runs"
(common:htree->html runs-htree
'()
(lambda (x p)
(let ((targpath (string-intersperse p "/"))
(runname (car (reverse p))))
(s:a runname 'href (conc targpath "/runsummary.html"))))
))))))
(close-output-port oup)
(common:simple-file-release-lock lockfile)
; (
#t)
#f)))
;; (let* ((outputfilename (conc "megatest-rollup-" test-name ".html"))
;; (orig-dir (current-directory))
;; (logf-info (rmt:test-get-logfile-info run-id test-name))
;; (logf (if logf-info (cadr logf-info) #f))
;; (path (if logf-info (car logf-info) #f)))
;; ;; This query finds the path and changes the directory to it for the test
|
| ︙ | | |