Megatest

Changes On Branch bcd244a86bb38071
Login

Changes In Branch v1.65-fixes Through [bcd244a86b] Excluding Merge-Ins

This is equivalent to a diff from 4021551b19 to bcd244a86b

2020-02-29
18:19
Pulled in some changes from v1.65 check-in: c12a0cf92c user: matt tags: v1.65-fixes
16:07
Beginnings of update of runs tree check-in: bcd244a86b user: matt tags: v1.65-fixes
2020-02-26
17:40
Save final test state and status in .final-status file in test directories. When considering marking a test DEAD, look at this file first to see if it actually passed, and if so, mark it PASSED. check-in: 7dbdcbf5a0 user: mmgraham tags: v1.65
15:08
wip check-in: 89ffda5553 user: matt tags: v1.65-fixes
2020-02-24
22:58
New dashboard view - the beginning check-in: 28423d4197 user: matt tags: v1.65-newview
20:48
Replace install of loadrunner (useless) with mtrunner (useful). check-in: 4021551b19 user: matt tags: v1.65
13:48
Create new branch named "v1.65-fixes" check-in: 909da9d639 user: matt tags: v1.65-fixes (unpublished)
2020-02-23
20:50
Added better feedback when #{get ...} is misused. check-in: 99e278145e user: matt tags: v1.65

Modified dashboard.scm from [2679042d5f] to [2a51c77172].

429
430
431
432
433
434
435




















































436
437
438
439
440
441
442
  ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
  key-vals
  ((last-update   0)                 : number)    ;; last query to db got records from before last-update
  ((last-db-time  0)                 : number)    ;; last timestamp on megatest.db
  ((data-changed  #f)                : boolean)   
  ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
  (db-path #f))





















































;; register dboard:rundat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
                 (cons dboard:rundat?
                       (lambda (tabdat-item)
                         (filter







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
  ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
  key-vals
  ((last-update   0)                 : number)    ;; last query to db got records from before last-update
  ((last-db-time  0)                 : number)    ;; last timestamp on megatest.db
  ((data-changed  #f)                : boolean)   
  ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
  (db-path #f))

;; for the new runs view lets build up a few new record types and then consolidate later
;;
;; this is a two level deep pipeline for the incoming data:
;;   sql query data ==> filters ==> data for display
;;
(defstruct dboard:rdat
  ;; data from sql db
  (keys  (rmt:get-keys))         ;; to be removed when targets handling is refactored
  (runs  (make-sparse-vector))   ;; id => runrec
  (targ-runid (make-hash-table)) ;; target/runname => run-id
  (tests (make-hash-table))      ;; test[/itempath] => list of test rec

  ;; sql filters 
  targ-sql-filt
  runname-sql-filt
  state-sql-filt
  status-sql-filt

  ;; other sql related fields
  (last-update 0)                ;; timestamp of the last update from sql db, set to zero on any field changes

  ;; filtered data
  (cols  (make-sparse-vector))
  (tests (make-hash-table))      ;; test[/itempath] => (vector columnnum => test rec)

  ;; various
  (prev-run-ids  '())            ;; push previously looked at runs on this
  (view-changed #f)

  ;; widgets
  (runs-tree #f)                 ;; 
  )

(define (dboard:rdat-push-run-id rdat run-id)
  (dboard:rdat-prev-run-ids-set! rdat (cons run-id (dboard:rdat-prev-run-ids rdat))))

(defstruct dboard:runrec
  id
  target  ;; a/b/c...
  tdef    ;; for future use
  )
     
(defstruct dboard:testrec
  id
  runid
  testname  ;; test[/itempath]
  state
  status
  start-time
  duration
  )

;; register dboard:rundat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
                 (cons dboard:rundat?
                       (lambda (tabdat-item)
                         (filter
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
	 (tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
	 (test-patterns-textbox  #f))
    (hash-table-set! tests-draw-state 'first-time #t)
    ;; (hash-table-set! tests-draw-state 'scalef 1)
    (tests:get-full-data test-names test-records '() all-tests-registry)
    (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
    
    ;; refer to (dboard:tabdat-keys tabdat), (dboard:tabdat-dbkeys tabdat) for keys
    (let* ((result
	    (iup:vbox
	     (dcommon:command-execution-control tabdat)
	     (iup:split
	      #:orientation "VERTICAL" ;; "HORIZONTAL"
	      #:value 200
	      ;; 







|







1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
	 (tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
	 (test-patterns-textbox  #f))
    (hash-table-set! tests-draw-state 'first-time #t)
    ;; (hash-table-set! tests-draw-state 'scalef 1)
    (tests:get-full-data test-names test-records '() all-tests-registry)
    (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
    
    ;; refer to (dboard:tabcodat-keys tabdat), (dboard:tabdat-dbkeys tabdat) for keys
    (let* ((result
	    (iup:vbox
	     (dcommon:command-execution-control tabdat)
	     (iup:split
	      #:orientation "VERTICAL" ;; "HORIZONTAL"
	      #:value 200
	      ;; 
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465

1466

1467

1468
1469
1470
1471
1472
1473
1474
1475
1476
1477


1478



1479
1480
1481
1482
1483
1484
1485
1486
1487
1488

1489



1490

1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507

1508

































































1509


1510
1511
1512
1513
1514
1515
1516
 ;;	 (dboard:tabdat-logs-textbox-set! tabdat logs-tb)
 ;;	 logs-tb))

;; browse runs as a tree. Used in both "Runs" tab and
;; in the runs control panel.
;;
(define (dboard:runs-tree-browser commondat tabdat)
  (let* (
	 (txtbox (iup:textbox #:action (lambda (val a b)
					 (debug:catch-and-dump
					  (lambda ()
					    ;; for the Runs view we put the list of keyvals into tabdat target

					    ;; for the Run Controls we put then update the run-command

					    (if b (dboard:tabdat-target-set! tabdat (string-split b "/")))

					    (dashboard:update-run-command tabdat))
					  "command-testname-selector tb action"))
			      #:value (dboard:test-patt->lines
				       (dboard:tabdat-test-patts-use tabdat))
			      #:expand "HORIZONTAL"
			      ;; #:size "10x30"
			      ))
	 (tb
          (iup:treebox
           #:value 0


           #:title "Runs" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."



           #:expand "YES"
           #:addexpanded "YES"
           #:size "10x"
           #:selection-cb
           (lambda (obj id state)
             (debug:catch-and-dump
              (lambda ()
                (let* ((run-path (tree:node->path obj id))
                       (run-id    (tree-path->run-id tabdat (cdr run-path))))
                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number

                  (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print "run-path: " run-path)



		  (iup:attribute-set! txtbox "VALUE" (string-intersperse (cdr run-path) "/"))

		  (dashboard:update-run-command tabdat)
                  (dboard:tabdat-layout-update-ok-set! tabdat #f)
                  (if (number? run-id)
                      (begin
                        ;; capture last two in tabdat.
                        (dboard:tabdat-prev-run-id-set!
                         tabdat
                         (dboard:tabdat-curr-run-id tabdat))
                        (dboard:tabdat-curr-run-id-set! tabdat run-id)
                        (dboard:tabdat-view-changed-set! tabdat #t))
                      (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
              "treebox"))
           ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
           )))
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:detachbox
     (iup:vbox 

      tb

































































      txtbox))))



;;======================================================================
;; R U N   C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;







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



>
>
|
>
>
>









|
>
|
>
>
>
|
>

















>

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







1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
 ;;	 (dboard:tabdat-logs-textbox-set! tabdat logs-tb)
 ;;	 logs-tb))

;; browse runs as a tree. Used in both "Runs" tab and
;; in the runs control panel.
;;
(define (dboard:runs-tree-browser commondat tabdat)
  (let* ((txtbox (iup:textbox
		  #:action (lambda (val a b)
			     (debug:catch-and-dump
			      (lambda ()
				;; for the Runs view we put the list
				;; of keyvals into tabdat target for
				;; the Run Controls we put then update
				;; the run-command
				(if b (dboard:tabdat-target-set! tabdat
								 (string-split b "/")))
				(dashboard:update-run-command tabdat))
			      "command-testname-selector tb action"))
		  #:value (dboard:test-patt->lines
			   (dboard:tabdat-test-patts-use tabdat))
		  #:expand "HORIZONTAL"
		  ;; #:size "10x30"
		  ))
	 (tb
          (iup:treebox
           #:value 0
           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
			      ;;  this... "Changed: [DEPRECATED
			      ;;  REMOVED] removed the old attribute
			      ;;  NAMEid from IupTree to avoid
			      ;;  conflict with the common attribute
			      ;;  NAME. Use the TITLEid attribute."
           #:expand "YES"
           #:addexpanded "YES"
           #:size "10x"
           #:selection-cb
           (lambda (obj id state)
             (debug:catch-and-dump
              (lambda ()
                (let* ((run-path (tree:node->path obj id))
                       (run-id    (tree-path->run-id tabdat (cdr run-path))))
                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ??
                  ;; done below when run-id is a number
                  (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print
								    ;; "run-path:
								    ;; "
								    ;; run-path)
		  (iup:attribute-set! txtbox "VALUE"
				      (string-intersperse (cdr run-path) "/"))
		  (dashboard:update-run-command tabdat)
                  (dboard:tabdat-layout-update-ok-set! tabdat #f)
                  (if (number? run-id)
                      (begin
                        ;; capture last two in tabdat.
                        (dboard:tabdat-prev-run-id-set!
                         tabdat
                         (dboard:tabdat-curr-run-id tabdat))
                        (dboard:tabdat-curr-run-id-set! tabdat run-id)
                        (dboard:tabdat-view-changed-set! tabdat #t))
                      (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
              "treebox"))
           ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
           )))
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:detachbox
     (iup:vbox 
      txtbox
      tb
      ))))

;; browse runs as a tree. Used in both "Runs" tab and
;; in the runs control panel.
;;
;;  THIS IS THE NEW ONE
;;
(define (dboard:runs-tree-new-browser commondat rdat)
  (let* ((txtbox (iup:textbox
		  #:action (lambda (val a b)
			     (debug:catch-and-dump
			      (lambda ()
				;; for the Runs view we put the list
				;; of keyvals into tabdat target for
				;; the Run Controls we put then update
				;; the run-command
				(if b (dboard:rdat-targ-sql-filt-set! rdat
								 (string-split b "/")))
				#;(dashboard:update-run-command tabdat))
			      "command-testname-selector tb action"))
		  ;; #:value (dboard:test-patt->lines  ;; This seems like it was wrong, BUG in code where it was copied from?
	          ;;		   (dboard:tabdat-test-patts-use tabdat))
		  #:expand "HORIZONTAL"
		  ;; #:size "10x30"
		  ))
	 (tb
          (iup:treebox
           #:value 0
           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
			      ;;  this... "Changed: [DEPRECATED
			      ;;  REMOVED] removed the old attribute
			      ;;  NAMEid from IupTree to avoid
			      ;;  conflict with the common attribute
			      ;;  NAME. Use the TITLEid attribute."
           #:expand "YES"
           #:addexpanded "YES"
           #:size "10x"
           #:selection-cb
           (lambda (obj id state)
             (debug:catch-and-dump
              (lambda ()
                (let* ((run-path (tree:node->path obj id))
                       (run-id    (new-tree-path->run-id rdat (cdr run-path))))
                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ??
                  ;; done below when run-id is a number
                  (dboard:rdat-targ-sql-filt-set! rdat (cdr run-path)) ;; (print
								    ;; "run-path:
								    ;; "
								    ;; run-path)
		  (iup:attribute-set! txtbox "VALUE"
				      (string-intersperse (cdr run-path) "/"))
		  #;(dashboard:update-run-command tabdat)
                  #;(dboard:tabdat-layout-update-ok-set! tabdat #f)
                  (if (number? run-id)
                      (begin
                        ;; capture last two in tabdat.
                        (dboard:rdat-push-run-id rdat run-id)
			(dboard:rdat-view-changed-set! rdat #t))
                      (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
              "treebox"))
           ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
           )))
    (dboard:rdat-runs-tree-set! rdat tb)
    (iup:detachbox
     (iup:vbox 
      txtbox
      tb
      ))))

;;======================================================================
;; R U N   C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
1672
1673
1674
1675
1676
1677
1678





1679
1680
1681
1682
1683
1684
1685
;;
;; display and manage a single run at a time

(define (tree-path->run-id tabdat path)
  (if (not (null? path))
      (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f)
      #f))






;; (define (dboard:get-tests-dat tabdat run-id last-update)
;;   (let* ((access-mode     (dboard:tabdat-access-mode tabdat))
;;          (tdat (if run-id (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run
;;                                              run-id 
;; 					     (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
;; 					     (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))  ;; '()







>
>
>
>
>







1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
;;
;; display and manage a single run at a time

(define (tree-path->run-id tabdat path)
  (if (not (null? path))
      (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f)
      #f))

(define (new-tree-path->run-id rdat path)
  (if (not (null? path))
      (hash-table-ref/default (dboard:rdat-path-run-ids tabdat) path #f)
      #f))

;; (define (dboard:get-tests-dat tabdat run-id last-update)
;;   (let* ((access-mode     (dboard:tabdat-access-mode tabdat))
;;          (tdat (if run-id (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run
;;                                              run-id 
;; 					     (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
;; 					     (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))  ;; '()
2426
2427
2428
2429
2430
2431
2432

















2433

























































2434
2435
2436

2437
2438
2439
2440
2441
2442
2443
				      (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
				      (iup:attribute-set! obj "MAX" (* maxruns 10))))
		#:expand "HORIZONTAL"
		#:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10))
		#:min 0
		#:step 0.01))












































































(define (make-dashboard-buttons commondat) ;;  runs-sum-dat new-view-dat)
  (let* ((stats-dat       (dboard:tabdat-make-data))
	 (runs-dat        (dboard:tabdat-make-data))

	 (onerun-dat      (dboard:tabdat-make-data)) ;; name for run-summary structure 
	 (runcontrols-dat (dboard:tabdat-make-data))
	 (runtimes-dat    (dboard:tabdat-make-data))
	 (nruns           (dboard:tabdat-numruns runs-dat))
	 (ntests          (dboard:tabdat-num-tests runs-dat))
	 (keynames        (dboard:tabdat-dbkeys runs-dat))
	 (nkeys           (length keynames))







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



>







2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
				      (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
				      (iup:attribute-set! obj "MAX" (* maxruns 10))))
		#:expand "HORIZONTAL"
		#:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10))
		#:min 0
		#:step 0.01))

;; make-simple-run                   procedure (target3772 id3773 runname3774 state3775 status3776 owner3777 event_time3778)
;; rmt:simple-get-runs               procedure (runpatt1001 count1002 offset1003 target1004)
;; simple-run-event_time             procedure (x3834)
;; simple-run-event_time-set!        procedure (x3830 val3831)
;; simple-run-id                     procedure (x3794)
;; simple-run-id-set!                procedure (x3790 val3791)
;; simple-run-owner                  procedure (x3826)
;; simple-run-owner-set!             procedure (x3822 val3823)
;; simple-run-runname                procedure (x3802)
;; simple-run-runname-set!           procedure (x3798 val3799)
;; simple-run-state                  procedure (x3810)
;; simple-run-state-set!             procedure (x3806 val3807)
;; simple-run-status                 procedure (x3818)
;; simple-run-status-set!            procedure (x3814 val3815)
;; simple-run-target                 procedure (x3786)
;; simple-run-target-set!            procedure (x3782 val3783)
;; simple-run?                       procedure (x3780)

;; runs is <vec header runs>
;;
(define (dashboard:update-runs-data data rdat)
  (let* ((tb (dboard:rdat-runs-tree rdat)))
    ;; update runs       id              => runrec
    ;; update targ-runid target/runname  => run-id
    (for-each
     (lambda (runrec)
       (let* ((run-id (simple-run-id runrec))
	      (full-targ-runname (conc (simple-run-target runrec) "/"
				       (simple-run-runname runrec))))
	 (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec)
	 (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id)
	 (tree:add-node tb "Runs" (string-split full-targ-runname "/"))
	 ))
     data)))

(define (new-runs-updater commondat rdat)
  (let* ((last-update       (dboard:rdat-last-update     rdat))
	 (targ-sql-filt    (dboard:rdat-targ-sql-filt    rdat))
	 (runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
	 (state-sql-filt   (dboard:rdat-state-sql-filt   rdat))
	 (status-sql-filt  (dboard:rdat-status-sql-filt  rdat))
	 ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
	 (newdata          (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt last-update)))
    (dashboard:update-runs-data newdata rdat)
    (dboard:rdat-last-update-set! rdat (- (current-seconds) 10))
    '()))
	 
(define (make-runs-view commondat rdat tab-num)
  ;; register an updater
  (dboard:commondat-add-updater
   commondat
   (lambda ()
     (new-runs-updater commondat rdat))
   tab-num: tab-num)

  (iup:vbox
   (iup:split
    #:orientation "VERTICAL" ;; "HORIZONTAL"
    #:value 100
    (dboard:runs-tree-new-browser commondat rdat)
    (iup:vbox (iup:button "Pushme"))
    #;(iup:split
    #:value 100
    ;; left most block, including row names
    ;; (apply iup:vbox lftlst)
    ;; right hand block, including cells
    (iup:vbox
    #:expand "YES"
    ;; the header
    (apply iup:hbox (reverse hdrlst))
    (apply iup:hbox (reverse bdylst))
    (dashboard:runs-horizontal-slider runs-dat))))
   ;; controls
   ))

(define (make-dashboard-buttons commondat) ;;  runs-sum-dat new-view-dat)
  (let* ((stats-dat       (dboard:tabdat-make-data))
	 (runs-dat        (dboard:tabdat-make-data))
	 (runs2-dat       (make-dboard:rdat)) ;; (dboard:tabdat-make-data))
	 (onerun-dat      (dboard:tabdat-make-data)) ;; name for run-summary structure 
	 (runcontrols-dat (dboard:tabdat-make-data))
	 (runtimes-dat    (dboard:tabdat-make-data))
	 (nruns           (dboard:tabdat-numruns runs-dat))
	 (ntests          (dboard:tabdat-num-tests runs-dat))
	 (keynames        (dboard:tabdat-dbkeys runs-dat))
	 (nkeys           (length keynames))
2475
2476
2477
2478
2479
2480
2481



2482

2483
2484
2485
2486
2487
2488
2489


2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
					res))
				    keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels



	(set! lftlst (append lftlst (list (iup:hbox  #:expand "HORIZONTAL"

						     (iup:valuator #:valuechanged_cb (lambda (obj)
										       (let ((val (string->number (iup:attribute obj "VALUE")))
											     (oldmax  (string->number (iup:attribute obj "MAX")))
											     (newmax  (* 10 (length (dboard:tabdat-all-test-names runs-dat)))))
											 (dboard:commondat-please-update-set! commondat #t)
											 (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10))))
											 (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) " (dboard:tabdat-start-test-offset runs-dat) " val: " val " newmax: " newmax " oldmax: " oldmax)


											 (if (< val 10)
											     (iup:attribute-set! obj "MAX" newmax))
											 ))
								   #:expand "VERTICAL" 
								   #:orientation "VERTICAL"
								   #:min 0
								   #:step 0.01)
						     (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" ;; the testname labels
				 #:flat "YES" 
				 #:alignment "ALEFT"
					; #:image img1
					; #:impress img2
				 #:size  (conc cell-width btn-height)







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







2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
					res))
				    keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst
	      (append lftlst
		      (list (iup:hbox
			     #:expand "HORIZONTAL"
			     (iup:valuator
			      #:valuechanged_cb (lambda (obj)
						  (let ((val (string->number (iup:attribute obj "VALUE")))
							(oldmax  (string->number (iup:attribute obj "MAX")))
							(newmax  (* 10 (length (dboard:tabdat-all-test-names runs-dat)))))
						    (dboard:commondat-please-update-set! commondat #t)
						    (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10))))
						    (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) "
								 (dboard:tabdat-start-test-offset runs-dat) " val: " val
								 " newmax: " newmax " oldmax: " oldmax)
						    (if (< val 10)
							(iup:attribute-set! obj "MAX" newmax))
						    ))
			      #:expand "VERTICAL" 
			      #:orientation "VERTICAL"
			      #:min 0
			      #:step 0.01)
			     (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" ;; the testname labels
				 #:flat "YES" 
				 #:alignment "ALEFT"
					; #:image img1
					; #:impress img2
				 #:size  (conc cell-width btn-height)
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
			    (apply iup:hbox (reverse hdrlst))
			    (apply iup:hbox (reverse bdylst))
			    (dashboard:runs-horizontal-slider runs-dat))))
			 controls
			 ))
	     (views-cfgdat (common:load-views-config))
	     (additional-tabnames '())
	     (tab-start-num       5)   ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
	     ;; (data (dboard:tabdat-init (make-d:data)))
	     (additional-views 	;; process views-dat
	      (let ((tab-num tab-start-num)
		    (result  '()))
		(for-each
		 (lambda (view-name)
		   (debug:print 0 *default-log-port* "Adding view " view-name)







|







2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
			    (apply iup:hbox (reverse hdrlst))
			    (apply iup:hbox (reverse bdylst))
			    (dashboard:runs-horizontal-slider runs-dat))))
			 controls
			 ))
	     (views-cfgdat (common:load-views-config))
	     (additional-tabnames '())
	     (tab-start-num       6)   ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
	     ;; (data (dboard:tabdat-init (make-d:data)))
	     (additional-views 	;; process views-dat
	      (let ((tab-num tab-start-num)
		    (result  '()))
		(for-each
		 (lambda (view-name)
		   (debug:print 0 *default-log-port* "Adding view " view-name)
2646
2647
2648
2649
2650
2651
2652

2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664

2665
2666
2667
2668
2669
2670
2671
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
               
						   (dboard:commondat-please-update-set! commondat #t)
						   (dboard:tabdat-layout-update-ok-set! tabdat #t)))
					       "tabchangepos"))
			  (dashboard:summary commondat stats-dat tab-num: 0)
			  runs-view

			  (dashboard:runs-summary commondat onerun-dat tab-num: 2)
			  ;; (dashboard:new-view db data new-view-dat tab-num: 3)
			  (dashboard:run-controls commondat runcontrols-dat tab-num: 3)
			  (dashboard:run-times commondat runtimes-dat tab-num: 4)
			  ;; (dashboard:runs-summary commondat onerun-dat tab-num: 4)
			  additional-views)))
	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
	(iup:attribute-set! tabs "TABTITLE0" "Summary")
	(iup:attribute-set! tabs "TABTITLE1" "Runs")
	(iup:attribute-set! tabs "TABTITLE2" "Run Summary")
	(iup:attribute-set! tabs "TABTITLE3" "Run Control")
	(iup:attribute-set! tabs "TABTITLE4" "Run Times")

	;; (iup:attribute-set! tabs "TABTITLE3" "New View")
	;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")

	;; set the tab names for user added tabs
	(for-each
	 (lambda (tab-info)
	   (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info)))







>
|

|
|





|
|
|
>







2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
               
						   (dboard:commondat-please-update-set! commondat #t)
						   (dboard:tabdat-layout-update-ok-set! tabdat #t)))
					       "tabchangepos"))
			  (dashboard:summary commondat stats-dat tab-num: 0)
			  runs-view
			  (make-runs-view commondat runs2-dat 2)
			  (dashboard:runs-summary commondat onerun-dat tab-num: 3)
			  ;; (dashboard:new-view db data new-view-dat tab-num: 3)
			  (dashboard:run-controls commondat runcontrols-dat tab-num: 4)
			  (dashboard:run-times commondat runtimes-dat tab-num: 5)
			  ;; (dashboard:runs-summary commondat onerun-dat tab-num: 4)
			  additional-views)))
	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
	(iup:attribute-set! tabs "TABTITLE0" "Summary")
	(iup:attribute-set! tabs "TABTITLE1" "Runs")
	(iup:attribute-set! tabs "TABTITLE2" "Runs2")
	(iup:attribute-set! tabs "TABTITLE3" "Run Summary")
	(iup:attribute-set! tabs "TABTITLE4" "Run Control")
	(iup:attribute-set! tabs "TABTITLE5" "Run Times")
	;; (iup:attribute-set! tabs "TABTITLE3" "New View")
	;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")

	;; set the tab names for user added tabs
	(for-each
	 (lambda (tab-info)
	   (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info)))
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
       fres))))

(define (dashboard:runs-tab-updater commondat tab-num)
  (debug:catch-and-dump 
   (lambda ()
     (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
	    (dbkeys (dboard:tabdat-dbkeys tabdat)))
       ;;(print "RA => calling runs-tab-updater with commondat " commondat " tab-num " tab-num)
       ;;(tabdat-values tabdat) ;;RA added 
       ;; (pp (dboard:tabdat->alist tabdat))
       ;; (if (dashboard:database-changed? commondat tabdat context-key: 'runs-rundat)      
       (dashboard:do-update-rundat tabdat)
       ;;(debug:print-info 13 *default-log-port* "dashboard:runs-tab-updater")
       ;;(inspect tabdat)

       (let ((uidat (dboard:commondat-uidat commondat)))
	 ;;(print "RA => Calling update-buttons with tabdat : " tabdat " uidat " uidat)
	 (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
       ))
   "dashboard:runs-tab-updater"))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================







<
<
<
<

<
<
<

<







3637
3638
3639
3640
3641
3642
3643




3644



3645

3646
3647
3648
3649
3650
3651
3652
       fres))))

(define (dashboard:runs-tab-updater commondat tab-num)
  (debug:catch-and-dump 
   (lambda ()
     (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
	    (dbkeys (dboard:tabdat-dbkeys tabdat)))




       (dashboard:do-update-rundat tabdat)



       (let ((uidat (dboard:commondat-uidat commondat)))

	 (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
       ))
   "dashboard:runs-tab-updater"))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================
3467
3468
3469
3470
3471
3472
3473





3474
3475
3476
3477
3478
3479
3480
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)





	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)







>
>
>
>
>







3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 2)
	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)

Modified db.scm from [8a077942c3] to [f22e159a5f].

2024
2025
2026
2027
2028
2029
2030




2031
2032
2033
2034
2035
2036
2037
		       (lambda (key)
			 (set! res (cons key res)))
		       db
		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
	(set! *db-keys* res)
	res)))





;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (if (or (null? header) (not row))
      #f
      (let loop ((hed (car header))
                 (tal (cdr header))
                 (n   0))







>
>
>
>







2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
		       (lambda (key)
			 (set! res (cons key res)))
		       db
		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
	(set! *db-keys* res)
	res)))

;; extract index number given a header/data structure
(define (db:get-index-by-header header field)
  (list-index (lambda (x)(equal? x field)) header))

;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (if (or (null? header) (not row))
      #f
      (let loop ((hed (car header))
                 (tal (cdr header))
                 (n   0))
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228




2229
2230
2231
2232
2233
2234

2235
2236
2237
2238
2239
2240
2241
(define-record simple-run target id runname state status owner event_time)
(define-record-printer (simple-run x out)
  (fprintf out "#,(simple-run ~S ~S ~S ~S)"
	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))

;; simple get-runs
;;
(define (db:simple-get-runs dbstruct runpatt count offset target)
    (let* ((res       '())
	   (keys       (db:get-keys dbstruct))
	   (runpattstr (db:patt->like "runname" runpatt))
	   (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
	   (targstr    (string-intersperse keys "||'/'||"))
	   (keystr     (conc targstr " AS target,"
			     (string-intersperse remfields ",")))
	   (qrystr     (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
			     ;; Generate: " AND x LIKE 'keypatt' ..."
			     " AND target LIKE '" target "'"
			     " AND state != 'deleted' ORDER BY event_time DESC "




			     (if (number? count)
				 (conc " LIMIT " count)
				 "")
			     (if (number? offset)
				 (conc " OFFSET " offset)
				 ""))))

    (debug:print-info 11 *default-log-port* "db:get-runs START qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    (db:with-db dbstruct #f #f
		(lambda (db)		
		  (sqlite3:for-each-row
		   (lambda (target id runname state status owner event_time)
		     (set! res (cons (make-simple-run target id runname state status owner event_time) res)))
		   db







|










|
>
>
>
>





|
>







2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
(define-record simple-run target id runname state status owner event_time)
(define-record-printer (simple-run x out)
  (fprintf out "#,(simple-run ~S ~S ~S ~S)"
	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))

;; simple get-runs
;;
(define (db:simple-get-runs dbstruct runpatt count offset target last-update)
    (let* ((res       '())
	   (keys       (db:get-keys dbstruct))
	   (runpattstr (db:patt->like "runname" runpatt))
	   (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
	   (targstr    (string-intersperse keys "||'/'||"))
	   (keystr     (conc targstr " AS target,"
			     (string-intersperse remfields ",")))
	   (qrystr     (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
			     ;; Generate: " AND x LIKE 'keypatt' ..."
			     " AND target LIKE '" target "'"
			     " AND state != 'deleted' "
			     (if (number? last-update)
				 (conc " AND last_update >= " last-update)
				 "")
			     " ORDER BY event_time DESC "
			     (if (number? count)
				 (conc " LIMIT " count)
				 "")
			     (if (number? offset)
				 (conc " OFFSET " offset)
				 "")))
	   )
    (debug:print-info 11 *default-log-port* "db:get-runs START qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    (db:with-db dbstruct #f #f
		(lambda (db)		
		  (sqlite3:for-each-row
		   (lambda (target id runname state status owner event_time)
		     (set! res (cons (make-simple-run target id runname state status owner event_time) res)))
		   db

Modified rmt.scm from [8c67a7dcdf] to [08548046ca].

733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:simple-get-runs runpatt count offset target)
  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:get-prev-run-ids run-id)
  (rmt:send-receive 'get-prev-run-ids #f (list run-id)))








|
|







733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:simple-get-runs runpatt count offset target last-update)
  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target last-update)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:get-prev-run-ids run-id)
  (rmt:send-receive 'get-prev-run-ids #f (list run-id)))

Modified runs.scm from [650378342c] to [1277a2dbd4].

2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
;;
(define (runs:get-hash-by-target target-patts runpatt)
  (let* ((targets (string-split target-patts ","))
	 (keys    (rmt:get-keys))
	 (res-ht  (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
    (for-each
     (lambda (target-patt)
       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt)))
	 (for-each
	  (lambda (run)
	    (let ((target (simple-run-target run)))
	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
	  runs)))
     targets)
    res-ht))







|







2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
;;
(define (runs:get-hash-by-target target-patts runpatt)
  (let* ((targets (string-split target-patts ","))
	 (keys    (rmt:get-keys))
	 (res-ht  (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
    (for-each
     (lambda (target-patt)
       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt #f)))
	 (for-each
	  (lambda (run)
	    (let ((target (simple-run-target run)))
	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
	  runs)))
     targets)
    res-ht))