Overview
Context
Changes
Modified multi-dboard.scm
from [aca154a76d]
to [0acf46cb12].
| ︙ | | |
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
-
+
+
-
+
+
+
+
+
+
+
|
(let* ((window-dat (hash-table-ref *windows* window-id))
(areas (data-areas window-dat))
(tabs (data-tabs window-dat))
(tab-ids (hash-table-keys tabs))
(current-tab (if (null? tab-ids)
#f
(hash-table-ref tabs (car tab-ids))))
(current-tree (if (null? tab-ids) #f (tab-tree current-tab))))
(current-tree (if (null? tab-ids) #f (tab-tree current-tab)))
(seen-nodes (make-hash-table)))
;; now for each area in the window gather the data
(for-each
(lambda (area-name)
(print "Processing for area-name " area-name)
(let* ((area-dat (hash-table-ref areas area-name))
(runs (areadat-runs area-dat)))
(print "Processing " area-dat " for area-name " area-name)
(areadb:populate-run-info area-dat)
(for-each
(lambda (run-id)
(let* ((run (hash-table-ref runs run-id))
(target (rundat-target run))
(runname (rundat-runname run)))
(if current-tree
(tree:add-node current-tree area-name (append (string-split target "/")(list runname))))
(let* ((partial-path (append (string-split target "/")(list runname)))
(full-path (cons area-name partial-path)))
(if (not (hash-table-exists? seen-nodes full-path))
(begin
(print "INFO: Adding node " partial-path " to section " area-name)
(tree:add-node current-tree "Areas" full-path)
(hash-table-set! seen-nodes full-path #t)))))
))
(hash-table-keys runs))))
(hash-table-keys areas))))
(hash-table-keys *windows*)))
;;======================================================================
;; D A S H B O A R D D B
|
| ︙ | | |
342
343
344
345
346
347
348
349
350
351
352
353
354
355
|
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
+
+
+
+
|
;;======================================================================
;; <area> - <target - ... > - <runname> - <test> - <itempath - ...>
(define (dashboard:tree-browser data adat window-id)
;; (iup:split
(let* ((tb (iup:treebox
#:value 0
#:title "Areas"
#:expand "YES"
#:addexpanded "NO"
#:selection-cb
(lambda (obj id state)
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((tree-path (tree:node->path obj id))
(area (car tree-path))
(areadat-path (cdr tree-path)))
#f
|
| ︙ | | |
Modified tests/Makefile
from [f77c8857a7]
to [0ec8867fd3].
| ︙ | | |
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
-
+
|
(cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\
done;done;done
test11 :
cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 ;do (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; )
build : ../*.scm
if killall mtest -v ;then sleep 5;killall mtest -v -9;fi
|
| ︙ | | |
Modified tree.scm
from [02f8628298]
to [1c5a9172b0].
| ︙ | | |
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
|
(if (> depth node-depth) ;; (+ 1 node-depth))
#f
(loop hed tal depth (+ nodenum 1)))))
#f))))
;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))
(let ((curr-top (iup:attribute obj "TITLE0")))
(if (or (not (string? (iup:attribute obj "TITLE0")))
(string-null? (iup:attribute obj "TITLE0")))
(iup:attribute-set! obj "ADDBRANCH0" top))
(cond
((not (equal? top (iup:attribute obj "TITLE0")))
(print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
((null? nodelst))
(else
(let loop ((hed (car nodelst))
(tal (cdr nodelst))
(depth 1)
(pathl (list top)))
;; Because the tree dialog changes node numbers when
;; nodes are added or removed we must look up nodes
;; each and every time. 0 is the top node so default
;; to that.
(let* ((newpath (append pathl (list hed)))
(parentnode (tree:find-node obj pathl))
(nodenum (tree:find-node obj newpath)))
;; Add the branch under lastnode if not found
(if (not nodenum)
(begin
(iup:attribute-set! obj (conc "ADDBRANCH" parentnode) hed)
(if (or (not (string? curr-top))
(string-null? curr-top)
(string-match "^\\s*$" curr-top))
(iup:attribute-set! obj "ADDBRANCH0" top))
(cond
((not (equal? top (iup:attribute obj "TITLE0")))
(print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
((null? nodelst))
(else
(let loop ((hed (car nodelst))
(tal (cdr nodelst))
(depth 1)
(pathl (list top)))
;; Because the tree dialog changes node numbers when
;; nodes are added or removed we must look up nodes
;; each and every time. 0 is the top node so default
;; to that.
(let* ((newpath (append pathl (list hed)))
(parentnode (tree:find-node obj pathl))
(nodenum (tree:find-node obj newpath)))
;; Add the branch under lastnode if not found
(if (not nodenum)
(begin
(iup:attribute-set! obj (conc "ADDBRANCH" parentnode) hed)
;; ERROR? ADDING DATA TO PARENT, DONT WE WANT IT ON CREATED NODE?
(if userdata
(iup:attribute-set! obj (conc "USERDATA" parentnode) userdata))
(if (null? tal)
#t
;; reset to top
(loop (car nodelst)(cdr nodelst) 1 (list top))))
(if (null? tal) ;; if null here then this path has already been added
#t
(loop (car tal)(cdr tal)(+ depth 1) newpath))))))))
(if userdata
(iup:attribute-set! obj (conc "USERDATA" parentnode) userdata))
(if (null? tal)
#t
;; reset to top
(loop (car nodelst)(cdr nodelst) 1 (list top))))
(if (null? tal) ;; if null here then this path has already been added
#t
(loop (car tal)(cdr tal)(+ depth 1) newpath)))))))))
(define (tree:node->path obj nodenum)
(let loop ((currnode 0)
(path '()))
(let* ((node-depth (string->number (iup:attribute obj (conc "DEPTH" currnode))))
(node-title (iup:attribute obj (conc "TITLE" currnode)))
(trimpath (if (and (not (null? path))
|
| ︙ | | |