Megatest

Changes On Branch c0371f685e1a243a
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch defstruct-srehman Through [c0371f685e] Excluding Merge-Ins

This is equivalent to a diff from e24aa68ed5 to c0371f685e

2016-09-26
13:40
Convert from vector record to defstruct for dbr:dbstruct check-in: 7c0396e31d user: mrwellan tags: v1.62
2016-09-23
17:40
inconsistency with defstruct var names and vars in db caused conflict, fixed check-in: 948f16e70d user: srehman tags: defstruct-srehman
17:14
improved consistency, fixed error with switching tests in Test tab check-in: c0371f685e user: srehman tags: defstruct-srehman
15:18
Update db check-in: b6c50d722b user: ritikaag tags: db
14:39
replaced vector return to db:test-rec return in two function calls check-in: e5509ad8b9 user: srehman tags: defstruct-srehman
11:16
merged with latest v1.62 check-in: d9c3068419 user: srehman tags: defstruct-srehman
2016-09-21
09:11
moved readline fix include out of the if. Update copyright date. Block when running db migration IF version bumped check-in: e24aa68ed5 user: mrwellan tags: v1.62
2016-09-19
11:08
Put the db migration into a thread to not block starting the dashboard check-in: 3046301f07 user: mrwellan tags: v1.62

Modified dashboard.scm from [40b640dfe5] to [f6381828f9].

︙
900
901
902
903
904
905
906
907


908
909
910
911
912
913
914

900
901
902
903
904
905
906

907
908
909
910
911
912
913
914
915








-
+
+








		(if (and buttondat
			 (hash-table? testsdat-by-name))
		    (let* ((testdat      (let ((matching (hash-table-ref/default testsdat-by-name testname #f)))
					   ;; (filter 
					   ;;   (lambda (x)(equal? (test:test-get-fullname x) testname))
					   ;;     testsdat)))
					   (if (not matching)
					       (vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
					       ;;(vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
					       (make-db:test-rec id: -1)
					       ;; (car matching))))
					       matching)))
			   (testname     (db:test-get-testname   testdat))
			   (itempath     (db:test-get-item-path  testdat))
			   (testfullname (test:test-get-fullname testdat))
			   (teststatus   (db:test-get-status     testdat))
			   (teststate    (db:test-get-state      testdat))
︙
1419
1420
1421
1422
1423
1424
1425
1426
1427


1428
1429
1430
1431
1432
1433
1434

1420
1421
1422
1423
1424
1425
1426


1427
1428
1429
1430
1431
1432
1433
1434
1435








-
-
+
+








					     (if (dboard:tabdat-filters-changed tabdat)
						 0
						 last-update)
					     *dashboard-mode*)
		  '()))) ;; get 'em all
    ;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
    (sort tdat (lambda (a b)
		 (let* ((aval (vector-ref a 2))
			(bval (vector-ref b 2))
		 (let* ((aval (db:test-get-testname a));;(vector-ref a 2))
			(bval (db:test-get-testname b));;(vector-ref b 2))
			(anum (string->number aval))
			(bnum (string->number bval)))
		   (if (and anum bnum)
		       (< anum bnum)
		       (string<= aval bval)))))))
︙

Modified db.scm from [248b7f3532] to [aefc44cdb9].

︙
2256
2257
2258
2259
2260
2261
2262
2263




2264
2265
2266
2267
2268
2269
2270

2256
2257
2258
2259
2260
2261
2262

2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273








-
+
+
+
+








				    ";"
				    )))
	(debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry)
	(db:with-db dbstruct run-id #f
		    (lambda (db)
		      (sqlite3:for-each-row 
		       (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
			 (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
			 ;;(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
			 ;;(print (cons a b))
		      	 (set! res (cons (alist->db:test-rec (db:qry-gen-alist qryvalstr (cons a b))) res)))
		       
		       db
		       qry
		       run-id
		       )))
	(case qryvals
	  ((shortlist)(map db:test-short-record->norm res))
	  ((#f)       res)
︙
2289
2290
2291
2292
2293
2294
2295
2296


2297
2298
2299
2300
2301
2302
2303

2304
2305
2306
2307
2308
2309


2310
2311
2312
2313
2314
2315
2316

2292
2293
2294
2295
2296
2297
2298

2299
2300
2301
2302
2303
2304
2305
2306

2307
2308
2309
2310
2311
2312

2313
2314
2315
2316
2317
2318
2319
2320
2321








-
+
+






-
+





-
+
+








				(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)))
		     ;;(set! res (cons (vector id run-id testname state status -1         ""     -1      -1       ""    "-"  item-path -1           "-"         "-") res)))
		     (set! res (cons (make-db:test-rec id: id testname: testname item_path: item-path state: state status: status) res)))
		   db 
		   qry
		   run-id)))
    res))

(define (db:get-testinfo-state-status dbstruct run-id test-id)
  (let ((res            #f))
  (let ((res            '()))
    (db:with-db dbstruct run-id #f
		(lambda (db)
		  (sqlite3:for-each-row
		   (lambda (run-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 (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-")))
		     ;;(set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-")))
		     (set! res (make-db:test-rec run_id: run-id testname: testname item_path: item-path state: state status: status)))
		   db 
		   "SELECT run_id,testname,item_path,state,status FROM tests WHERE id=?;" 
		   test-id)))
    res))

;; get a useful subset of the tests data (used in dashboard
;; use db:mintest-get-{id ,run_id,testname ...}
︙
2573
2574
2575
2576
2577
2578
2579
2580





2581
2582
2583
2584
2585
2586
2587

2578
2579
2580
2581
2582
2583
2584

2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596








-
+
+
+
+
+








		    dbstruct)) ;; still settling on when to use dbstruct or dbdat
	 (db    (db:dbdat-get-db dbdat))
	 (res '()))
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
       ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14     15        16
       (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
       ;;(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
       (set! res (cons (make-db:test-rec id: id run-id: run-id testname: testname state: state status: status event_time: event-time
       		host: host cpuload: cpuload diskfree: diskfree uname: uname rundir: rundir item_path: item-path
       		run_duration: run-duration final_logf: final-logf comment: comment shortdir: shortdir 
       		attemptnum: attemptnum archived: archived )
		       res)))
     db
     (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
     run-id)
    res))

(define (db:replace-test-records dbstruct run-id testrecs)
︙
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

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








-
+

-
+
+
+
+
+


















+
-
+














+
-
+








  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)
	(lambda (id run-id test-name state status event-time host cpu-load disk-free uname run-dir item-path run-duration final-logf comment short-dir attempt-num archived)
	  ;;             0    1       2      3      4        5       6      7        8     9     10      11          12          13           14         15          16
	  (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)))
	  ;;(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final-logf comment short-dir attemptnum archived)))
	  (set! res (make-db:test-rec id: id run-id: run-id test-name: test-name state: state status: status event-time: event-time
       		host: host cpu-load: cpu-load disk-free: disk-free uname: uname run-dir: run-dir item-path: item-path
       		run-duration: run-duration final-logf: final-logf comment: comment short-dir: short-dir 
       		attempt-num: attempt-num archived: archived)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
	test-id)
       res))))

;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
;;
(define (db:get-test-info-by-ids dbstruct run-id test-ids)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res '()))
       (sqlite3:for-each-row
	(lambda (a . b)
	  ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14
	  (set! res (cons (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b))) res)))
	  (set! res (cons (apply vector a b) res)))
	  ;;(set! res (cons (apply vector a b) res)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
	      (string-intersperse (map conc test-ids) ",") ");"))
       res))))

(define (db:get-test-info dbstruct run-id testname item-path)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row
	(lambda (a . b)
	  (set! res (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b)))))
	  (set! res (apply vector a b)))
	  ;;(set! res (apply vector a b)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;")
	test-name item-path)
       res))))

(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)
  (db:with-db
︙

Modified db_records.scm from [64b6bb0323] to [4495f8ce16].

︙
63
64
65
66
67
68
69




















70














71
72
73
74
75
76
77
78
79
80
81











82
83
84
85
86
87
88
89







90
91
92
93
94
95
96

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104











105
106
107
108
109
110
111
112
113
114
115








116
117
118
119
120
121
122
123
124
125
126
127
128
129








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

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








;;
(define (dbr:dbstruct-get-localdb v run-id)
  (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f))

(define (dbr:dbstruct-set-localdb! v run-id db)
  (hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db))

(require-extension typed-records)
(defstruct db:test-rec ((id -1) : number)
					((run-id -1) : number) 
					((test-name "") : string)
					((state "") : string)
					((status "") : string)
					((event-time -1) : number)
					((host "") : string)
					((cpu-load -1) : number)
					((disk-free -1) : number)
					((uname "") : string)
					((run-dir "") : string)
					((item-path "") : string)
					((run-duration -1) : number)
					((final-logf "") : string)
					((comment "") : string)
					((process-id -1) : number)
					((archived -1) : number)
					((short-dir -1) : number)
					((attempt-num -1) : number))

(define (db:qry-gen-alist qrystr listvals)
	(define listqry (string-split qrystr ","))
	(if (null? listqry)
	      '()
	      (let loop ((strhead (car listqry))
			 (strtail (cdr listqry))
			 (valhead (car listvals))
			 (valtail (cdr listvals))
			 (res '()))
		(let* ((slot-val-pair (cons (string->symbol strhead) valhead)))
		  (if (or (null? strtail)
		  		(null? valtail))
		      (cons slot-val-pair res);;(print strhead valhead));;(cons (cons (string->symbol strhead) valhead) res))
		      (loop (car strtail)(cdr strtail)(car valtail)(cdr valtail)(cons slot-val-pair res)))))))
(define (make-db:test)(make-vector 20))
(define-inline (db:test-get-id           vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id       vec) (vector-ref vec 1))
(define-inline (db:test-get-testname     vec) (vector-ref vec 2))
(define-inline (db:test-get-state        vec) (vector-ref vec 3))
(define-inline (db:test-get-status       vec) (vector-ref vec 4))
(define-inline (db:test-get-event_time   vec) (vector-ref vec 5))
(define-inline (db:test-get-host         vec) (vector-ref vec 6))
(define-inline (db:test-get-cpuload      vec) (vector-ref vec 7))
(define-inline (db:test-get-diskfree     vec) (vector-ref vec 8))
(define-inline (db:test-get-uname        vec) (vector-ref vec 9))

(define (db:test-get-id			typed-rec)   (db:test-rec-id 		typed-rec))
(define (db:test-get-run_id 	typed-rec)	 (db:test-rec-run-id 	typed-rec))
(define (db:test-get-testname   typed-rec)   (db:test-rec-test-name typed-rec))
(define (db:test-get-state      typed-rec)   (db:test-rec-state 	typed-rec))
(define (db:test-get-status     typed-rec)   (db:test-rec-status 	typed-rec))
(define (db:test-get-event_time typed-rec)   (db:test-rec-event-time typed-rec))
(define (db:test-get-host       typed-rec)   (db:test-rec-host 		typed-rec))
(define (db:test-get-cpuload    typed-rec)   (db:test-rec-cpu-load 	typed-rec))
(define (db:test-get-diskfree   typed-rec)   (db:test-rec-disk-free 	typed-rec))
(define (db:test-get-uname      typed-rec)   (db:test-rec-uname 	typed-rec))
;; (define-inline (db:test-get-rundir       vec) (sdb:qry 'getstr (vector-ref vec 10)))
(define-inline (db:test-get-rundir       vec) (vector-ref vec 10))
(define-inline (db:test-get-item-path    vec) (vector-ref vec 11))
(define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
(define-inline (db:test-get-final_logf   vec) (vector-ref vec 13))
(define-inline (db:test-get-comment      vec) (vector-ref vec 14))
(define-inline (db:test-get-process_id   vec) (vector-ref vec 16))
(define-inline (db:test-get-archived     vec) (vector-ref vec 17))
(define (db:test-get-rundir     typed-rec)   (db:test-rec-run-dir 	typed-rec))
(define (db:test-get-item-path  typed-rec)   (db:test-rec-item-path typed-rec))
(define (db:test-get-run_duration typed-rec)  (db:test-rec-run-duration typed-rec))
(define (db:test-get-final_logf typed-rec)   (db:test-rec-final-logf typed-rec))
(define (db:test-get-comment    typed-rec)   (db:test-rec-comment 	typed-rec))
(define (db:test-get-process_id typed-rec)   (db:test-rec-process-id typed-rec))
(define (db:test-get-archived   typed-rec)   (db:test-rec-archived 	typed-rec))

;; (define-inline (db:test-get-pass_count   vec) (vector-ref vec 15))
;; (define-inline (db:test-get-fail_count   vec) (vector-ref vec 16))
(define-inline (db:test-get-fullname     vec)
  (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))

;; replace runs:make-full-test-name with this routine
︙

Modified runs.scm from [de4f2b1394] to [ac6ff009be].

︙
1698
1699
1700
1701
1702
1703
1704
1705

1706
1707
1708
1709
1710
1711
1712

1698
1699
1700
1701
1702
1703
1704

1705
1706
1707
1708
1709
1710
1711
1712








-
+








		    (thread-start! worker-thread))
		   (else
		    (debug:print-info 0 *default-log-port* "action not recognised " action)))
		 
		 ;; actions that operate on one test at a time can be handled below
		 ;;
		 (let ((sorted-tests     (filter 
					  vector?
					  db:test-rec?
					  (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr 
									  (db:test-get-rundir a)) ;; )  ;; (filedb:get-path *fdb* (db:test-get-rundir a)))
									 (dirb ;; (rmt:sdb-qry 'getstr 
									  (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b))))
								     (if (and (string? dira)(string? dirb))
									 (> (string-length dira)(string-length dirb))
									 #f))))))
︙

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