| ︙ | | | ︙ | |
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
|
test-data)))
runs)
resh))
;; tests:genrate dashboard body
;;
(define (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links flag)
(let* ((start (* page pg-size))
(runsdat (rmt:get-runs "%" pg-size start (map (lambda (x)(list x "%")) keys)))
(header (vector-ref runsdat 0))
(runs (vector-ref runsdat 1))
(ctr 0)
(test-runs-hash (tests:get-rest-data runs header numkeys))
(test-list (hash-table-keys test-runs-hash))
)
|
|
|
>
>
|
|
|
<
>
|
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
|
test-data)))
runs)
resh))
;; tests:genrate dashboard body
;;
(define (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links flag run-patt target-patt)
(let* ((start (* page pg-size))
;(runsdat (rmt:get-runs "%" pg-size start (map (lambda (x)(list x "%")) keys)))
(runsdat (rmt:get-runs-by-patt keys run-patt target-patt start pg-size #f 0))
; db:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-update
(header (vector-ref runsdat 0))
(runs (vector-ref runsdat 1))
(ctr 0)
(test-runs-hash (tests:get-rest-data runs header numkeys))
(test-list (hash-table-keys test-runs-hash)))
(print header )
(s:html tests:css-jscript-block (tests:css-jscript-block-cond flag)
(s:title "Summary for " area-name)
(s:body 'onload "addEvents();"
(get-prev-links page linktree)
(get-next-links page linktree total-runs)
(s:h1 "Summary for " area-name)
|
| ︙ | | | ︙ | |
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
|
runs))))
(set! ctr (+ ctr 1))
res))
keys)
(s:tr
(s:th "Run Name")
(map (lambda (run)
(s:th (vector-ref run 3)))
runs))
(map (lambda (test-name)
(let* ((item-hash (hash-table-ref/default test-runs-hash test-name #f))
(item-keys (sort (hash-table-keys item-hash) string<=?)))
(map (lambda (item-name)
(let* ((res (s:tr 'class item-name
|
|
|
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
|
runs))))
(set! ctr (+ ctr 1))
res))
keys)
(s:tr
(s:th "Run Name")
(map (lambda (run)
(s:th (db:get-value-by-header run header "runname")))
runs))
(map (lambda (test-name)
(let* ((item-hash (hash-table-ref/default test-runs-hash test-name #f))
(item-keys (sort (hash-table-keys item-hash) string<=?)))
(map (lambda (item-name)
(let* ((res (s:tr 'class item-name
|
| ︙ | | | ︙ | |
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
|
item-keys)))
test-list))))))
;; (tests:create-html-tree "test-index.html")
;;
(define (tests:create-html-tree outf)
(let* ((lockfile (conc outf ".lock"))
(runs-to-process '())
(linktree (common:get-linktree))
(area-name (common:get-testsuite-name))
(keys (rmt:get-keys))
(numkeys (length keys))
(total-runs (rmt:get-num-runs "%"))
(pg-size 10))
(if (common:simple-file-lock lockfile)
(begin
;(print total-runs)
(let loop ((page 0))
(let* ((oup (open-output-file (or outf (conc linktree "/page" page ".html"))))
(get-prev-links (lambda (page linktree )
(let* ((link (if (not (eq? page 0))
(s:a "<<prev" 'href (conc linktree "/page" (- page 1) ".html"))
(s:a "" 'href (conc linktree "/page" page ".html")))))
link)))
(get-next-links (lambda (page linktree total-runs)
(let* ((link (if (> total-runs (+ 10 (* page pg-size)))
(s:a "next>>" 'href (conc linktree "/page" (+ page 1) ".html"))
(s:a "" 'href (conc linktree "/page" page ".html")))))
link))) )
;(print (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name))
(s:output-new
oup
(tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #f))
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
<
|
|
|
|
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
|
item-keys)))
test-list))))))
;; (tests:create-html-tree "test-index.html")
;;
(define (tests:create-html-tree outf)
(let* ((lockfile (conc outf ".lock"))
(runs-to-process '())
(linktree (common:get-linktree))
(area-name (common:get-testsuite-name))
(keys (rmt:get-keys))
(numkeys (length keys))
(run-patt (if (args:get-arg "-run-patt")
(args:get-arg "-run-patt")
"%"))
(target (if (args:get-arg "-target-patt")
(args:get-arg "-target-patt")
"%"))
(targlist (string-split target "/"))
(numtarg (length targlist))
(targtweaked (if (> numkeys numtarg)
(append targlist (make-list (- numkeys numtarg) "%"))
targlist))
(target-patt (string-join targtweaked "/"))
;(total-runs (rmt:get-num-runs "%")) ;;this needs to be changed to filter by target
(total-runs (rmt:get-runs-cnt-by-patt run-patt target-patt keys ))
(pg-size 10))
(if (common:simple-file-lock lockfile)
(begin
;(print total-runs)
(let loop ((page 0))
(let* ((oup (open-output-file (or outf (conc linktree "/page" page ".html"))))
(get-prev-links (lambda (page linktree )
(let* ((link (if (not (eq? page 0))
(s:a "<<prev" 'href (conc linktree "/page" (- page 1) ".html"))
(s:a "" 'href (conc linktree "/page" page ".html")))))
link)))
(get-next-links (lambda (page linktree total-runs)
(let* ((link (if (> total-runs (+ 10 (* page pg-size)))
(s:a "next>>" 'href (conc linktree "/page" (+ page 1) ".html"))
(s:a "" 'href (conc linktree "/page" page ".html")))))
link))) )
(s:output-new
oup
(tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #f run-patt target-patt)) ;; update this function
(close-output-port oup)
; (set! page (+ 1 page))
(if (> total-runs (* (+ 1 page) pg-size))
(loop (+ 1 page)))))
(common:simple-file-release-lock lockfile))
#f)))
|
| ︙ | | | ︙ | |
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
|
(define (tests:dynamic-dboard page)
;(define (tests:create-html-tree o)
(let* (
;(page "1")
(linktree (common:get-linktree))
(area-name (common:get-testsuite-name))
(keys (rmt:get-keys))
(numkeys (length keys))
(total-runs (rmt:get-num-runs "%"))
(pg-size 10)
(pg (if (equal? page #f)
0
(- (string->number page) 1)))
(get-prev-links (lambda (pg linktree)
(debug:print-info 0 *default-log-port* "val: " (- 1 pg))
(let* ((link (if (not (eq? pg 0))
(s:a "<<prev " 'href (conc "dashboard?page=" pg ))
(s:a "" 'href (conc "dashboard?page=" pg)))))
link)))
(get-next-links (lambda (pg linktree total-runs)
(debug:print-info 0 *default-log-port* "val: " pg)
(debug:print-info 0 *default-log-port* "val: " total-runs " size" pg-size)
(let* ((link (if (> total-runs (+ 10 (* pg pg-size)))
(s:a "next>> " 'href (conc "dashboard?page=" (+ pg 2) ))
(s:a "" 'href (conc "dashboard?page=" pg )))))
link)))
(html-body (tests:dashboard-body pg pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #t)))
;(print (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name))
html-body))
(define (tests:create-html-summary outf)
(let* ((lockfile (conc outf ".lock"))
(linktree (common:get-linktree))
(keys (rmt:get-keys))
(area-name (common:get-testsuite-name))
(run-patt (if (args:get-arg "-run-patt")
|
|
|
>
>
|
<
|
|
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
|
(define (tests:dynamic-dboard page)
;(define (tests:create-html-tree o)
(let* (
;(page "1")
(linktree (common:get-linktree))
(area-name (common:get-testsuite-name))
(keys (rmt:get-keys))
(numkeys (length keys))
(targtweaked (make-list numkeys "%"))
(target-patt (string-join targtweaked "/"))
(total-runs (rmt:get-num-runs "%"))
(pg-size 10)
(pg (if (equal? page #f)
0
(- (string->number page) 1)))
(get-prev-links (lambda (pg linktree)
(debug:print-info 0 *default-log-port* "val: " (- 1 pg))
(let* ((link (if (not (eq? pg 0))
(s:a "<<prev " 'href (conc "dashboard?page=" pg ))
(s:a "" 'href (conc "dashboard?page=" pg)))))
link)))
(get-next-links (lambda (pg linktree total-runs)
(debug:print-info 0 *default-log-port* "val: " pg)
(debug:print-info 0 *default-log-port* "val: " total-runs " size" pg-size)
(let* ((link (if (> total-runs (+ 10 (* pg pg-size)))
(s:a "next>> " 'href (conc "dashboard?page=" (+ pg 2) ))
(s:a "" 'href (conc "dashboard?page=" pg )))))
link)))
(html-body (tests:dashboard-body pg pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #t "%" target-patt))) ;; update tis function
html-body))
(define (tests:create-html-summary outf)
(let* ((lockfile (conc outf ".lock"))
(linktree (common:get-linktree))
(keys (rmt:get-keys))
(area-name (common:get-testsuite-name))
(run-patt (if (args:get-arg "-run-patt")
|
| ︙ | | | ︙ | |
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
|
(let* ((tbl (map (lambda (target)
(s:tr
(s:td 'class "test" target)
(let* ((runs (hash-table-ref/default target-hash target #f))
(rest-row (map (lambda (run)
(if (equal? run "")
(s:td run)
(s:td
(s:a 'href (conc linktree "/" target "/" run "/run.html") run))))
(reverse runs))))
rest-row)))
targets)))
tbl)))))
(close-output-port oup)))
|
>
>
|
|
|
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
|
(let* ((tbl (map (lambda (target)
(s:tr
(s:td 'class "test" target)
(let* ((runs (hash-table-ref/default target-hash target #f))
(rest-row (map (lambda (run)
(if (equal? run "")
(s:td run)
(if (file-exists?(conc linktree "/" target "/" run ))
(begin
(s:td
(s:a 'href (conc linktree "/" target "/" run "/run.html") run))))))
(reverse runs))))
rest-row)))
targets)))
tbl)))))
(close-output-port oup)))
|
| ︙ | | | ︙ | |