Overview
Context
Changes
Modified Makefile
from [3d18e35c4e]
to [15819b35ee].
| ︙ | | |
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
-
-
+
+
-
-
-
-
+
+
+
+
+
+
+
-
+
+
+
|
http-transport.scm filedb.scm tdb.scm \
client.scm mt.scm \
ezsteps.scm lock-queue.scm sdb.scm \
rmt.scm api.scm subrun.scm \
portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm
# module source files
MSRCFILES = ftail.scm rmtmod.scm commonmod.scm ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm
# ftail.scm rmtmod.scm commonmod.scm removed
MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm
# Eggs to install (straightforward ones)
EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \
dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \
json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \
spiffy-directory-listing ssax sxml-serializer sxml-modifications iup canvas-draw sqlite3
EGGS=matchable readline aokpropos base64 regex-literals format \
regex-case test coops trace csv dot-locking posix-utils posix-extras \
directory-utils hostinfo tcp-server rpc csv-xml fmt json md5 awful \
http-client spiffy uri-common intarweb spiffy-request-vars \
spiffy-directory-listing ssax sxml-serializer sxml-modifications iup \
canvas-draw sqlite3
GUISRCF = dashboard-context-menu.scm dashboard-tests.scm \
GUISRCF = dashboard-context-menu.scm dashboard-tests.scm dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm vg.scm
|
| ︙ | | |
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
+
+
-
-
+
+
|
# ARCHSTR=$(shell bash -c "echo \$$MACHTYPE")
PNGFILES = $(shell cd docs/manual;ls *png)
#all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut ndboard
all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut tcmt
megatest.o : ducttape-lib.import.o
mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) mofiles/ftail.o mofiles/rmtmod.o mofiles/commonmod.o
csc $(CSCOPTS) $(OFILES) $(MOFILES) megatest.o -o mtest
mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) $(MOIMPFILES) ducttape-lib.import.o
csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest
showmtesthash:
@echo $(MTESTHASH)
dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES)
csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) -o dboard
|
| ︙ | | |
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
+
+
+
+
+
+
+
+
+
+
+
-
-
+
|
mofiles/stml2.o : mofiles/cookie.o
vg.o dashboard.o : vg_records.scm
dcommon.o : run_records.scm
mofiles/stml2.o : mofiles/cookie.o
# special include based modules
mofiles/pkts.o : pkts/pkts.scm
# mofiles/mtargs.o : mtargs/mtargs.scm
# mofiles/mtconfigf.o : mtconfigf/mtconfigf.scm
# mofiles/ulex.o : ulex/ulex.scm
mofiles/mutils.o : mutils/mutils.scm
mofiles/cookie.o : stml2/cookie.scm
mofiles/stml2.o : stml2/stml2.scm
# Temporary while transitioning to new routine
# runs.o : run-tests-queue-classic.scm run-tests-queue-new.scm
# for the modularized stuff
mofiles/rmtmod.o : mofiles/commonmod.o \
mofiles/ducttape-lib.o mofiles/pkts.o mofiles/stml2.o mofiles/mutils.o
|
| ︙ | | |
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
|
-
+
|
mkdir -p ext-tests
cd ext-tests;fossil open --nested $(MTQA_FOSSIL)
$(MTQA_FOSSIL) :
fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)
clean :
rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut tcmt ftail.import.scm readline-fix.scm serialize-env dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut tcmt readline-fix.scm serialize-env dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o commonmod.o cookie.o dashboard-main.o ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o tcmt.o
rm -rf share
#======================================================================
# Make the records files
#======================================================================
# vg_records.scm : records.sh
|
| ︙ | | |
Modified dashboard.scm
from [1c32cae59a]
to [0930c846ee].
| ︙ | | |
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
|
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
|
-
+
|
(define (new-runs-updater commondat rdat)
(let* ((runnum (dboard:rdat-runnum rdat))
(start-time (current-milliseconds))
(tot-runs #f))
(if (eq? runnum 0)(dashboard:update-runs-data rdat))
(set! tot-runs (vector-length (dboard:rdat-runsbynum rdat)))
(let loop ((rn runnum))
(if (and (< (- (current-milliseconds) start-time) 500)
(if (and (< (- (current-milliseconds) start-time) 250)
(< rn tot-runs))
(let* ((newrn (if (>= runnum (vector-length (dboard:rdat-runsbynum rdat)))
0 ;; start over
(+ rn 1)))) ;; (+ runnum 1)))
(dashboard:update-run-data rn rdat)
(dboard:rdat-runnum-set! rdat newrn)
(if (> newrn 0)
|
| ︙ | | |
Modified megatest.scm
from [5076719cbe]
to [38ca1a10c0].
| ︙ | | |
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (include "common.scm")
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
readline apropos json http-client directory-utils typed-records
http-client srfi-18 extras format)
;; Added for csv stuff - will be removed
;;
(use sparse-vectors)
(import mutils ducttape-lib)
;; (use zmq)
|
| ︙ | | |
Modified tests.scm
from [320f98768e]
to [bf1af44b82].
| ︙ | | |
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
-
-
-
-
+
+
+
+
+
|
;;
;;======================================================================
;;======================================================================
;; Tests
;;======================================================================
(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
(import (prefix sqlite3 sqlite3:))
(import stml2)
|
| ︙ | | |
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
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
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
|
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
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
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
|
-
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
|
;; 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 "%" 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 sort-order: "desc"))
; db:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-update
(header (vector-ref runsdat 0))
(runs (vector-ref runsdat 1))
(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)
(s:h3 "Filter" )
(s:input 'type "text" 'name "testname" 'id "testname" 'length "30" 'onkeyup "filtersome()")
;; top list
(s:table 'id "LinkedList1" 'border "1" 'cellspacing 0
(map (lambda (key)
(let* ((res (s:tr 'class "something"
(s:th key )
(map (lambda (run)
(s:th (vector-ref run ctr)))
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)
(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)
(s:h3 "Filter" )
(s:input 'type "text" 'name "testname" 'id "testname" 'length "30" 'onkeyup "filtersome()")
;; top list
(s:table 'id "LinkedList1" 'border "1" 'cellspacing 0
(map (lambda (key)
(let* ((res (s:tr 'class "something"
(s:th key )
(map (lambda (run)
(s:th (vector-ref run ctr)))
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
(s:td item-name 'class "test" )
(map (lambda (run)
(let* ((run-test (hash-table-ref/default item-hash item-name #f))
(run-id (db:get-value-by-header run header "id"))
(result (hash-table-ref/default run-test run-id "n/a"))
;(relative-path (get-relative-path))
(status (if (string? result)
result
(car result)))
(link (if (string? result)
result
(if (equal? flag #t)
(s:a (car result) 'href (conc "./test_log?runid=" run-id "&testname=" item-name ))
(s:a (car result) 'href (string-substitute (conc linktree "/") "" (cadr result) "-"))))))
(s:td link 'class status)))
runs))))
res))
item-keys)))
test-list))))))
(s:td item-name 'class "test" )
(map (lambda (run)
(let* ((run-test (hash-table-ref/default item-hash item-name #f))
(run-id (db:get-value-by-header run header "id"))
(result (hash-table-ref/default run-test run-id "n/a"))
;(relative-path (get-relative-path))
(status (if (string? result)
result
(car result)))
(link (if (string? result)
result
(if (equal? flag #t)
(s:a (car result) 'href (conc "./test_log?runid=" run-id "&testname=" item-name ))
(s:a (car result) 'href (string-substitute (conc linktree "/") "" (cadr result) "-"))))))
(s:td link 'class status)))
runs))))
res))
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 '())
(keys (rmt:get-keys))
(numkeys (length keys))
(args:get-arg "-runname")
"%"))
(args:get-arg "-target")
(args:get-arg "-target")
"%"))
(targlist (string-split target "/"))
(numtarg (length targlist))
(targtweaked (if (> numkeys numtarg)
(append targlist (make-list (- numkeys numtarg) "%"))
targlist))
(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 ))
;(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 "page" (- page 1) ".html"))
(s:a "" 'href (conc "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 "page" (+ page 1) ".html"))
(s:a "" 'href (conc "page" page ".html")))))
link))) )
(print "total runs: " total-runs)
(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)))))
#f)))
(begin
(debug-print 0 *default-log-port* "Failed to get lock on file outf, lockfile: " lockfile) #f))))
(define (tests:readlines filename)
(call-with-input-file filename
(lambda (p)
(let loop ((line (read-line p))
(result '()))
|
| ︙ | | |