Overview
Context
Changes
Modified common.scm
from [609c3adc2f]
to [5db22c5710].
︙ | | |
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
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
|
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
|
(debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)))
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; GLOBAL GLETCHES
(define-record megatest:area
name
path
transport
configinfo
configdat
denoise
client-signature
remote
run-keys
name ;; area name
path ;; mt run area home
transport ;; defaults to http
configinfo ;; legacy config format
configdat ;; megatest config
denoise ;; focal point for not
client-signature ;; key for client-server conversation
remote ;; hash of all the client side connnections
run-keys ;; target keys for this area
runs ;; used in dashboard
read-only ;; can I write to this area?
)
(define *already-seen-runconfig-info* #f)
(define *waiting-queue* (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus* 0) ;; attempt to work around possible thread issues
(define *passnum* 0) ;; when running track calls to run-tests or similar
|
︙ | | |
Modified dashboard.scm
from [42ca30b425]
to [50bbb611aa].
︙ | | |
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
0))
(if (args:get-arg "-h")
(begin
(print help)
(exit)))
;;; REMOVE ME, this is a stop-gap
(define *area-dat* (make-megatest:area
"default" ;; area name
#f ;; area path
'http ;; transport
#f ;; configinfo
#f ;; configdat
(make-hash-table) ;; denoise
#f ;; client signature
#f ;; remote connections
))
(if (not (launch:setup-for-run *area-dat*))
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
;; (if (args:get-arg "-host")
;; (begin
;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;; (client:launch))
;; (client:launch))
;; ease debugging by loading ~/.dashboardrc
|
︙ | | |
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
|
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
|
-
+
|
(iup:hbox))
;;======================================================================
;; D A S H B O A R D
;;======================================================================
(define (make-area-panel data area-name window-id)
(let* ((adat (hash-table-ref areas area-name))
(let* ((adat (hash-table-ref (dboard:data-areas data) area-name))
(tb (tree-browser data adat window-id)) ;; (dboard:areas-tree-browser data)
(ad (area-display data adat window-id))
(areas (dboard:data-areas data)))
(dboard:area-tree-set! adat tb)
(dboard:area-matrix-set! adat ad)
(iup:split
#:value 200
|
︙ | | |
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
|
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
|
-
+
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
|
(area-panels (map (lambda (aname)
(make-area-panel data aname window-id))
area-names))
(tabtop (apply iup:tabs areas)))
(let loop ((index 0)
(hed (car area-names))
(tal (cdr area-names)))
(let* ((apath (hash-table-ref (dboard:data-cfgdat data)) hed)
(let* ((apath (hash-table-ref (dboard:data-cfgdat data) hed))
(mtconf (read-config apath (make-hash-table) #f)) ;; megatest.config
(area-dat (make-megatest:area
hed ;; area name
apath ;; path to area
'http ;; transport
(list apath mtconf) ;; configinfo (legacy)
mtconf ;; megatest.config
(make-hash-table)
#f
(make-hash-table) ;; denoise hash
#f ;; client-signature
#f ;; remote connections
#f ;; run keys
(make-hash-table) ;; run-id -> (hash of test-ids => dat)
(and (file-exists? apath)(file-write-access? apath)) ;; read-only
)))
(hash-table-set! (dboard:data-areas data) hed
(make-dboard:area
#f ;; tree
#f ;; matrix
(and (file-exists? apath)
(file-write-access? apath))
area-dat
hed
area-dat ;;
#f ;; view path
'default ;; view type
#f ;; matrix
#f ;; controls
#f ;; cached data
#f ;; filters
#f ;; the run-id
(make-hash-table) ;; run-id -> test-id, for current test id
""
))
(debug:print 0 "Adding area " hed " with index " index " to dashboard")
(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
(if (not (null? tal))
(loop (+ index 1)(car tal)(cdr tal))))
tabtop)))))
|
︙ | | |
Modified dcommon.scm
from [f5b7561c68]
to [5d6b4a68c6].
︙ | | |
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
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
-
-
-
-
|
areas ;; hash of areaname -> area-rec
current-window-id
)
(define-record dboard:area
tree
matrix
read-only ;; #t => can't write
area-dat ;; the one-structure (one day dbstruct will be put in here)
name ;; name for this area
mpath ;; path to the megatest home (MT_RUN_AREA_HOME)
view-path ;; <target/path>/<runname>/...
view-type ;; standard, etc.
matrix ;; the spreadsheet
controls ;; the controls
data ;; all the data kept in sync with db
filters ;; user filters
run-id ;; the current run-id
test-ids ;; the current test id hash, run-id => test-id
command ;; the command from the entry field
;; dbstruct ;; not needed
)
(define-record dboard:filter
target ;; hash of widgets for the target
runname ;; the runname widget
testpatt ;; the testpatt widget
)
|
︙ | | |