Megatest

Check-in [a2115754e6]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:WIP
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64-areas-dashboard
Files: files | file ages | folders
SHA1: a2115754e62b5461156083a8f6be22db585cc3e2
User & Date: matt on 2017-08-01 04:57:24
Other Links: branch diff | manifest | tags
Context
2017-08-03
22:26
Updated with latest changes from v1.64 check-in: 5a8ae7b6c4 user: matt tags: v1.64-areas-dashboard
2017-08-01
04:57
WIP check-in: a2115754e6 user: matt tags: v1.64-areas-dashboard
2017-07-31
22:47
Copied/renamed more functions to enable Areas Summary tab development. Fixed deps for dboard with dashboard-areas.scm file. check-in: da3085c0ec user: matt tags: v1.64-areas-dashboard
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified dashboard-areas.scm from [59b814305b] to [9e4282d8cb].

︙︙
379
380
381
382
383
384
385
386
387






388
389










390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418

			  (let* ((record-a (hash-table-ref runs-hash a))
				 (record-b (hash-table-ref runs-hash b))
				 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
				 (time-b   (db:get-value-by-header record-b runs-header "event_time")))
			    (< time-a time-b)))))
         (changed      #f)
	 (last-runs-update  (dboard:tabdat-last-runs-update tabdat))
	 (runs-dat     (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
                                          (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)))






    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (for-each (lambda (run-id)










		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
					(dboard:tabdat-keys tabdat)))
		       (run-name   (db:get-value-by-header run-record runs-header "runname"))
		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
		       (run-path   (append key-vals (list run-name))))
		  (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
                      ;; (let ((existing   (tree:find-node tb run-path)))
                      ;;   (if (not existing)
                      (begin
                        (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
                        ;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
                        ;;    		 (conc rownum ":" colnum) col-name)
                        ;; (hash-table-set! runid-to-col run-id (list colnum run-record))
                        ;; Here we update the tests treebox and tree keys
                        (tree:add-node tb "Areas" run-path) ;; (append key-vals (list run-name))
                        ;;                                             userdata: (conc "run-id: " run-id))))
                        (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
                        ;; (set! colnum (+ colnum 1))
                        ))))
	      run-ids)))

(define (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash)
  (let* ((run          (hash-table-ref/default runs-hash run-id #f))
         (key-vals     (rmt:get-key-vals run-id))
         (testnamepatt (or (dboard:tabdat-test-patts tabdat) "%/%"))
         (tests-ht     (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
         (tests-dat    (dashboard:tests-ht->tests-dat tests-ht)) 
         (tests-mindat (dcommon:minimize-test-data tests-dat)))  ;; reduces data for display








<
|
>
>
>
>
>
>

|
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|








379
380
381
382
383
384
385

386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433

			  (let* ((record-a (hash-table-ref runs-hash a))
				 (record-b (hash-table-ref runs-hash b))
				 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
				 (time-b   (db:get-value-by-header record-b runs-header "event_time")))
			    (< time-a time-b)))))
         (changed      #f)
	 (last-runs-update  (dboard:tabdat-last-runs-update tabdat))

	 (runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f 0)) ;; last-runs-update))
	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
         (runs         (vector-ref runs-dat 1))
	 (new-run-ids  (map (lambda (run)
			      (db:get-value-by-header run runs-header "id"))
			    runs))
	 (areas        (configf:get-section *configdat* "areas")))
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (for-each
     (lambda (area)
       (let ((run-path (list area)))
	 (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
	     (begin
	       (tree:add-node tb "Areas" run-path)
	       (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path 0)))))
     (map car areas))
    ;; here the local area
    (for-each
     (lambda (run-id)
       (let* ((run-record (hash-table-ref/default runs-hash run-id #f))
	      (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
			       (dboard:tabdat-keys tabdat)))
	      (run-name   (db:get-value-by-header run-record runs-header "runname"))
	      (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
	      (run-path   (cons "local " (append key-vals (list run-name)))))
	 (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
	     ;; (let ((existing   (tree:find-node tb run-path)))
	     ;;   (if (not existing)
	     (begin
	       (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
	       ;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
	       ;;    		 (conc rownum ":" colnum) col-name)
	       ;; (hash-table-set! runid-to-col run-id (list colnum run-record))
	       ;; Here we update the tests treebox and tree keys
	       (tree:add-node tb "Areas" run-path) ;; (append key-vals (list run-name))
	       ;;                                             userdata: (conc "run-id: " run-id))))
	       (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
	       ;; (set! colnum (+ colnum 1))
	       ))))
     (append new-run-ids run-ids)))) ;; for-each run-id
  
(define (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash)
  (let* ((run          (hash-table-ref/default runs-hash run-id #f))
         (key-vals     (rmt:get-key-vals run-id))
         (testnamepatt (or (dboard:tabdat-test-patts tabdat) "%/%"))
         (tests-ht     (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
         (tests-dat    (dashboard:tests-ht->tests-dat tests-ht)) 
         (tests-mindat (dcommon:minimize-test-data tests-dat)))  ;; reduces data for display
︙︙

Modified dashboard.scm from [76981852d9] to [954bbe82a3].

︙︙
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696

			(lambda (a b)
			  (let* ((record-a (hash-table-ref runs-hash a))
				 (record-b (hash-table-ref runs-hash b))
				 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
				 (time-b   (db:get-value-by-header record-b runs-header "event_time")))
			    (< time-a time-b)))))
         (changed      #f)
	 (last-runs-update  (dboard:tabdat-last-runs-update tabdat))
	 (runs-dat     (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
                                          (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)))
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (for-each (lambda (run-id)
		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
					(dboard:tabdat-keys tabdat)))
		       (run-name   (db:get-value-by-header run-record runs-header "runname"))
		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))








|
|
|








1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696

			(lambda (a b)
			  (let* ((record-a (hash-table-ref runs-hash a))
				 (record-b (hash-table-ref runs-hash b))
				 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
				 (time-b   (db:get-value-by-header record-b runs-header "event_time")))
			    (< time-a time-b)))))
         (changed      #f)
	 (last-runs-update  (dboard:tabdat-last-runs-update tabdat)))
    ;; (runs-dat     (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
       ;;                                   (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)))
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (for-each (lambda (run-id)
		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
					(dboard:tabdat-keys tabdat)))
		       (run-name   (db:get-value-by-header run-record runs-header "runname"))
		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
︙︙

Modified megatest.config from [32e70cadfe] to [a8d97f813e]. 

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19


## commented out due to a bug in v1.6501 in mtutil
[fields]
a text
b text
c text

[setup]
pktsdirs /tmp/pkts /some/other/source

[areas]

#         path-to-area   map-target-script(future, optional)
fullrun   path=tests/fullrun
# targtrans is name of scheme proc stored in .mtutil.scm, which lives in PWD where mtutil is run
# ext-tests path=ext-tests; targtrans=prefix-contour;
ext       path=ext-tests

[contours]
#     mode-patt/tag-expr












>
|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20


## commented out due to a bug in v1.6501 in mtutil
[fields]
a text
b text
c text

[setup]
pktsdirs /tmp/pkts /some/other/source

[areas]
#         path=path-to-area;targtrans=script_to_transform_target
local     path=.
fullrun   path=tests/fullrun
# targtrans is name of scheme proc stored in .mtutil.scm, which lives in PWD where mtutil is run
# ext-tests path=ext-tests; targtrans=prefix-contour;
ext       path=ext-tests

[contours]
#     mode-patt/tag-expr
︙︙

This page was generated in about 0.118s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00