Megatest

Diff
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Annotate Patch Side-by-side Diff

Differences From Artifact [7588b62ece]:

To Artifact [25662aed6c]:

︙
2277
2278
2279
2280
2281
2282
2283
2284




2285
2286
2287
2288
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
2317


2318
2319
2320
2321
2322
2323
2324

2325
2326
2327
2328
2329
2330


2331
2332
2333
2334
2335
2336
2337

2277
2278
2279
2280
2281
2282
2283

2284
2285
2286
2287
2288
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
2317
2318
2319
2320

2321
2322
2323
2324
2325
2326

2327
2328
2329
2330
2331
2332
2333
2334
2335








-
+
+
+
+












-
-
-
-
+
-
-
-
-












-
+
+






-
+





-
+
+








				    ";"
				    )))
	(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 (db:test-rec-from-qry-long (cons a b)) res)))
		       
		       db
		       qry
		       run-id
		       )))
	(case qryvals
	  ((shortlist)(map db:test-short-record->norm res))
	  ((#f)       res)
	  (else       res)))))

(define (db:test-short-record->norm inrec)
  ;;  "id,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
  (vector (vector-ref inrec 0) ;; id
	  (vector-ref inrec 1) ;; run_id
	  (vector-ref inrec 2) ;; testname
	  (vector-ref inrec 4) ;; state
	(make-db:test-rec id: -1))
	  (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)
  (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)))
		     ;;(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 ...}
︙
2592
2593
2594
2595
2596
2597
2598
2599

2600
2601





2602
2603
2604
2605
2606
2607
2608

2590
2591
2592
2593
2594
2595
2596

2597
2598

2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610








-
+

-
+
+
+
+
+








  (let* ((dbdat (if (vector? dbstruct)
		    (db:get-db dbstruct run-id)
		    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)
     (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)
︙
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

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








-
+

-
+
+
+
+
+


















+
-
+














+
-
+








  (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 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 (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 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 )))
	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 (db:test-rec-from-qry-long (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 (db:test-rec-from-qry-long (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
︙
2880
2881
2882
2883
2884
2885
2886











2887
2888
2889
2890
2891

2892
2893
2894
2895
2896
2897
2898
2899
2900
2901

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








+
+
+
+
+
+
+
+
+
+
+




-
+
-
-
-








;; foo,bal,   1.2,  1.2, <   ,     ,Check for overload
;; foo,alb,   1.2,  1.2, <=  , Amps,This is the high power circuit test
;; foo,abl,   1.2,  1.3, 0.1
;; foo,bra,   1.2, pass, silly stuff
;; faz,bar,    10,  8mA,     ,     ,"this is a comment"
;; EOF


(define (db:csv->list-safe csvdata)
  (if (string? csvdata)
      (csv->list (make-csv-reader
		  (open-input-string csvdata)
		  '((strip-leading-whitespace? #t)
		    (strip-trailing-whitespace? #t))))      
      (begin
	(debug:print 0 *default-log-port* "ERROR: received non-string data for csv")
	'())))

(define (db:csv->test-data dbstruct run-id test-id csvdata)
  (debug:print 4 *default-log-port* "test-id " test-id ", csvdata: " csvdata)
  (let* ((dbdat   (db:get-db dbstruct run-id))
	 (db      (db:dbdat-get-db dbdat))
	 (csvlist (csv->list (make-csv-reader
	 (csvlist (db:csv->list-safe csvdata)))
			      (open-input-string csvdata)
			      '((strip-leading-whitespace? #t)
				(strip-trailing-whitespace? #t)))))) ;; (csv->list csvdata)))
    (for-each
     (lambda (csvrow)
       (let* ((padded-row  (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9))
	      (category    (list-ref padded-row 0))
	      (variable    (list-ref padded-row 1))
	      (value       (any->number-if-possible (list-ref padded-row 2)))
	      (expected    (any->number-if-possible (list-ref padded-row 3)))
︙
This page was generated in about 0.112s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00