Megatest

Check-in [074a5dfda2]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-newview
Files: files | file ages | folders
SHA1: 074a5dfda2c9ce4d5d98e092edef0214a15e1243
User & Date: matt on 2020-03-01 21:37:17
Other Links: branch diff | manifest | tags
Context
2020-03-01
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:20
merge-wip check-in: a6e3ff583a user: matt tags: v1.65-newview
Changes

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

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))

Modified dashboard.scm from [2a51c77172] to [d1d33b9e46].

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
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







+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

+
+
+
+
+
+

-
+


-
+








;; 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
  (targ-runid (make-hash-table)) ;; target/runname => run-id
  (tests (make-hash-table))      ;; test[/itempath] => list of test rec
  (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

  ;; sql filters 
  targ-sql-filt
  runname-sql-filt
  state-sql-filt
  status-sql-filt
  ;; 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-update 0)                ;; timestamp of the last update from sql db, set to zero on any field changes
  (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))
  (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
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+

-
-
+
+
+
+
+
+
+
+
+
+
+









-

-
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+







;; 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 data rdat)
  (let* ((tb (dboard:rdat-runs-tree rdat)))
(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)
	 (tree:add-node tb "Runs" (string-split full-targ-runname "/"))
	 ))
     data)))
     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          (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* ((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))
  (let* ((runnum           (dboard:rdat-runnum          rdat)))
    (if (eq? runnum 0)(dashboard:update-runs-data rdat))
    
    



    
    ;; (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)
    (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))))
    (dboard:runs-new-matrix commondat rdat)
   ;; 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))

Modified db.scm from [51f9a29f1b] to [f4075ff80c].

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
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)

Modified rmt.scm from [08548046ca] to [fdb337291c].

555
556
557
558
559
560
561



562
563
564
565
566
567
568
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571







+
+
+







(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode)
  ;; (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)))