Megatest: Changes On Branch 879965196f0456b5

Changes In Branch v1.65-newview Through [879965196f] Excluding Merge-Ins

This is equivalent to a diff from 9529e99c78 to 879965196f

2020-03-02
09:17		Add fix to start server after 15 attempts check-in: 37d16ef457 user: jmoon18 tags: v1.65, v1.6543, v1.6544
2020-03-01
22:12		wip check-in: 9d160839b2 user: matt tags: v1.65-newview
21:47		wip check-in: 879965196f user: matt tags: v1.65-newview
21:37		wip check-in: 074a5dfda2 user: matt tags: v1.65-newview
01:19		Pulled in some changes from v1.65 check-in: 6ba016ecfe user: matt tags: v1.65-newview
2020-02-28
16:34		Speculative fix for zero cpus problem. check-in: 9529e99c78 user: mrwellan tags: v1.65
14:39		Added [scripts] section to testconfig check-in: 164020026e user: mrwellan tags: v1.65

Modified TODO from [e0a2376de1] to [21c315d3f7].

Modified api.scm from [a15c0cd809] to [8a3eb8aa72].

Modified dashboard.scm from [2679042d5f] to [7eca04ae95].

Modified db.scm from [4dafe820e6] to [f4075ff80c].

Modified rmt.scm from [8c67a7dcdf] to [fdb337291c].

Modified runs.scm from [d285c61578] to [6eaaaab4fe].

︙
56 57 58 59 60 61 62 63 64 65 66 67 68 69	56 57 58 59 60 61 62 63 64 65 66 67 68 69 70	+	get-run-times get-targets get-target ;; register-run get-tests-tags get-test-times get-tests-for-run get-tests-for-run-state-status get-test-id get-tests-for-runs-mindata get-tests-for-run-mindata get-run-name-from-id get-runs simple-get-runs get-num-runs
︙
290 291 292 293 294 295 296 297 298 299 300 301 302 303	291 292 293 294 295 296 297 298 299 300 301 302 303 304 305	+	;; RUNS ((get-run-info) (apply db:get-run-info dbstruct params)) ((get-run-status) (apply db:get-run-status dbstruct params)) ((get-run-state) (apply db:get-run-state dbstruct params)) ((set-run-status) (apply db:set-run-status dbstruct params)) ((set-run-state-status) (apply db:set-run-state-status dbstruct params)) ((get-tests-for-run) (apply db:get-tests-for-run dbstruct params)) ((get-tests-for-run-state-status) (apply db:get-tests-for-run-state-status dbstruct params)) ((get-test-id) (apply db:get-test-id dbstruct params)) ((get-tests-for-run-mindata) (apply db:get-tests-for-run-mindata dbstruct params)) ;; ((get-tests-for-runs-mindata) (apply db:get-tests-for-runs-mindata dbstruct params)) ((get-runs) (apply db:get-runs dbstruct params)) ((simple-get-runs) (apply db:simple-get-runs dbstruct params)) ((get-num-runs) (apply db:get-num-runs dbstruct params)) ((get-runs-cnt-by-patt) (apply db:get-runs-cnt-by-patt dbstruct params))
︙

︙
429 430 431 432 433 434 435 436 437 438 439 440 441 442	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 495 496 497 498 499 500 501 502 503 504 505 506 507 508	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	((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 ;; view related items (runnum 0) ;; which column we are processing, index into runsbynum, we sweep across all these runs then start over (leftcol 0) ;; number of the leftmost visible column (toprow 0) ;; topmost visible row (numcols 24) ;; number of columns visible (numrows 20) ;; number of rows visible ;; data from sql db (keys (rmt:get-keys)) ;; to be removed when targets handling is refactored (runs (make-sparse-vector)) ;; id => runrec (runsbynum (make-vector 100 #f)) ;; vector num => runrec (targ-runid (make-hash-table)) ;; area/target/runname => run-id ;; not sure this will be needed (tests (make-hash-table)) ;; test[/itempath] => list of test rec ;; run sql filters (targ-sql-filt "%") (runname-sql-filt "%") (run-state-sql-filt "%") (run-status-sql-filt "%") ;; test sql filter (testname-sql-filt "%") (itempath-sql-filt "%") (test-state-sql-filt "%") (test-status-sql-filt "%") ;; other sql related fields (last-updates (make-sparse-vector 0)) ;; run-id -> timestamp of the last update from sql db, set to zero on any field changes ;; filtered data (cols (make-sparse-vector)) ;; columnnum => run-id (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	1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490	- +	(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~~ ;; 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	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 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663	- - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + - + + + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + +	;; (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 lis~~t of keyvals into tabdat targe~~t ~~;; 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" )) (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 ~~#: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."~~ ;; 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) "/"))~~ ;; (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~~))))~~~~ 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	1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837	+ + + + +	;; ;; 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	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 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 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 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	(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) ;;====================================================================== ;; Extracting the data to display for runs ;; ;; This needs to be re-entrant such that it does one column per call ;; on the zeroeth call update runs data ;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded ;; on last run reset to zeroeth ;; ;; 1. select with run filters; area, target, runname, runstate, runstatus, starttime, duration ;; - put this information into two data structures: ;; a. hash of area/target/runname => runstruct #< ordernun, id, area, target, runname, state, ;; status, starttime, duration, non-deleted testcount> ;; ordernum reflects order as received from sql query ;; b. sparsevec of id => runstruct ;; 2. for each run in runshash ordered by ordernum do: ;; retrieve data since last update for that run ;; if there is a deleted test - retrieve full data ;; if there are non-deleted tests register this run in the columns sparsevec ;; if this is the zeroeth column regenerate the rows sparsevec ;; if this column is in the visible zone update visible cells ;; ;; Other factors: ;; 1. left index handling: ;; - add test/itempaths to left index as discovered, re-order and ;; update row -> test/itempath mapping on each read run ;;====================================================================== ;; runs is <vec header runs> ;; get ALL runs info ;; update rdat-targ-run-id ;; update rdat-runs ;; (define (dashboard:update-runs-data rdat) (let* ((tb (dboard:rdat-runs-tree rdat)) (targ-sql-filt (dboard:rdat-targ-sql-filt rdat)) (runname-sql-filt (dboard:rdat-runname-sql-filt rdat)) (state-sql-filt (dboard:rdat-run-state-sql-filt rdat)) (status-sql-filt (dboard:rdat-run-status-sql-filt rdat)) ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) (data (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f)) (numruns (length data))) ;; store in the runsbynum vector (dboard:rdat-runsbynum-set! rdat (list->vector data)) ;; 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) )) data) numruns)) ;; NOTE: runnum is NOT the run-id, it is a pointer into the runsbynum vector ;; (define (dashboard:update-run-data runnum rdat) (let* ((curr-time (current-seconds)) (runrec (vector-ref (dboard:rdat-runsbynum rdat) runnum)) (run-id (simple-run-id runrec)) (last-update (sparse-vector-ref (dboard:rdat-last-updates rdat) run-id)) ;; filters (testname-sql-filt (dboard:rdat-testname-sql-filt rdat)) ;; (itempath-sql-filt (dboard:rdat-itempath-sql-filt rdat)) (test-state-sql-filt (dboard:rdat-test-state-sql-filt rdat)) ;; not used yet (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat)) ;; not used yet (tests (rmt:get-tests-for-run-state-status run-id testname-sql-filt last-update ;; last-update ))) (debug:print 0 default-log-port "Got " (length tests) " tests") (length tests))) (define (new-runs-updater commondat rdat) (let* ((runnum (dboard:rdat-runnum rdat))) (if (eq? runnum 0)(dashboard:update-runs-data rdat)) (dashboard:update-run-data runnum rdat) (dboard:rdat-runnum-set! rdat (if (>= runnum (vector-length (dboard:rdat-runsbynum rdat))) 0 (+ runnum 1))) ;; (dboard:rdat-last-update-set! rdat (- (current-seconds) 10)) ;; (tree:add-node tb "Runs" (string-split full-targ-runname "/")) '())) (define (dboard:runs-new-matrix commondat rdat) (iup:matrix #:alignment1 "ALEFT" ;; #:expand "YES" ;; "HORIZONTAL" #:scrollbar "YES" #:numcol 10 #:numlin 20 #:numcol-visible 5 ;; (min 8) #:numlin-visible 1 #:click-cb (lambda (obj row col status) (let* ((cell (conc row ":" col))) #f)) )) (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) (dboard:runs-new-matrix commondat rdat) ))) (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	2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804	+ + + - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + +	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 ~~(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))))))) #: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	2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918	- +	(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~~ (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	2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973	+ - + - - + + - - - + + + +	(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: 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: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4)~~ (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" "Run ~~Summary~~") (iup:attribute-set! tabs "TABTITLE3" "Run ~~Cont~~rol") (iup:attribute-set! tabs "TABTITLE4" "Run ~~Times~~")~~ (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	3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733	- - - - - - - -	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 ;;======================================================================
︙
3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480	3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779	+ + + + +	(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)
︙

︙
2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083	2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087	+ + + +	(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))
︙
2256 2257 2258 2259 2260 2261 2262 ~~2263~~ 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 ~~2274~~ 2275 2276 2277 2278 2279 ~~2280~~ 2281 2282 2283 2284 2285 2286 2287	2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296	- + - + + + + + - + +	(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)~~ (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' ~~ORDER BY event_time DESC~~ "~~ " 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
︙
2870 2871 2872 2873 2874 2875 2876 ~~2877~~ 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899	2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929	- + + + + + + + + + + + + + + + + + + + + + +	(vector-ref inrec 2) ;; testname (vector-ref inrec 4) ;; state (vector-ref inrec 5) ;; status -1 "" -1 -1 "" "-" (vector-ref inrec 3) ;; item-path -1 "-" "-")) ~~(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)~~ #;(define (db:get-tests-for-run-state-status dbstruct run-id testpatt) (let* ((res '()) (tests-match-qry (tests:match->sqlqry testpatt)) (qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))) (debug:print-info 8 default-log-port "db:get-tests-for-run qry=" qry) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (id testname item-path state status) ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment (set! res (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res))) db qry run-id))) res)) (define (db:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0)) (let* ((res '()) (tests-match-qry (tests:match->sqlqry testpatt)) (qry (conc "SELECT id,testname,item_path,state,status,event_time,run_duration FROM tests WHERE run_id=? " " AND last_update > ? " (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") ))) (debug:print-info 8 default-log-port "db:get-tests-for-run qry=" qry) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:fold-row (lambda (id testname item-path state status event-time run-duration) ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment (cons (vector id run-id testname state status event-time "" -1 -1 "" "-" item-path run-duration "-" "-") res)) '() db qry run-id (or last-update 0)))) res)) (define (db:get-testinfo-state-status dbstruct run-id test-id) (let ((res #f)) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (run-id testname item-path state status)
︙

︙
556 557 558 559 560 561 562 563 564 565 566 567 568 569	556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572	+ + +	;; (if (number? run-id) (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode))) ;; (begin ;; (debug:print-error 0 default-log-port "rmt:get-tests-for-run called with bad run-id=" run-id) ;; (print-call-chain (current-error-port)) ;; '()))) (define (rmt:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0)) (rmt:send-receive 'get-tests-for-run-state-status run-id (list run-id testpatt last-update))) ;; get stuff via synchash (define (rmt:synchash-get run-id proc synckey keynum params) (rmt:send-receive 'synchash-get run-id (list run-id proc synckey keynum params))) (define (rmt:get-tests-for-run-mindata run-id testpatt states status not-in) (rmt:send-receive 'get-tests-for-run-mindata run-id (list run-id testpatt states status not-in)))
︙
733 734 735 736 737 738 739 ~~740 741~~ 742 743 744 745 746 747 748	736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751	- - + +	(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: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)))
︙