Overview
| Comment: | runs index works |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | html-tree |
| Files: | files | file ages | folders |
| SHA1: |
fd65f92d77c3967d8f145167a11bb029 |
| User & Date: | matt on 2016-10-17 01:09:48 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-10-17
| ||
| 01:32 | Added data get for runs summary html page check-in: 6ae61495e7 user: matt tags: html-tree | |
| 01:09 | runs index works check-in: fd65f92d77 user: matt tags: html-tree | |
|
2016-10-16
| ||
| 23:49 | Pulled in old stml code to make hierarchial html. check-in: a7cf53bc3a user: matt tags: html-tree | |
Changes
Modified common.scm from [cacda34afd] to [69895b157d].
| ︙ | ︙ | |||
644 645 646 647 648 649 650 |
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)
| > > > | | | > > > > > > | > | < < < < | | < | 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))
(y (cdr x))
(newpath (append path (list levelname)))
(leaf (or (not (hash-table? y))
(null? (hash-table-keys y)))))
(if leaf
(s:li (tipfunc y newpath))
(s:li
(list
levelname
(common:htree->html y newpath tipfunc))))))
datlist)))))
;; hash-table tree to alist tree
;;
(define (common:htree->atree ht)
(map (lambda (x)
(cons (car x)
(let ((y (cdr x)))
|
| ︙ | ︙ |
Modified tests.scm from [45e5456322] to [890366c265].
| ︙ | ︙ | |||
639 640 641 642 643 644 645 | </script> EOF ) ;; (tests:create-html-tree "test-index.html") ;; (define (tests:create-html-tree outf) | > > | > | | | | | | | | | | | | > | | | | | > | | | | | | | > > > | | | > | | | 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 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
|
| ︙ | ︙ |