Megatest

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

Changes In Branch v1.80-servload Through [4126673c03] Excluding Merge-Ins

This is equivalent to a diff from 66f2b72697 to 4126673c03

2023-05-06
16:39
Turn off find-and-mark-incomplete fully check-in: 3f75938dff user: matt tags: v1.80
2023-04-18
08:31
Start of moving rollup off the server check-in: 95c5f92eb5 user: matt tags: v1.80-servload
2023-04-17
23:12
Caching extended to couple more calls. Impact seems dramatic. However note that likely not all scenarios for clearing the cache are covered. check-in: 4126673c03 user: matt tags: v1.80-servload
17:28
cache get-test-info-by-id check-in: 1443998a16 user: matt tags: v1.80-servload
16:51
possible fixes to test Leaf check-in: 4ef17eb32c user: matt tags: v1.80-possible-fixes
2023-04-16
16:43
possible fix for bind issue check-in: 66f2b72697 user: matt tags: v1.80
2023-04-15
09:14
merged fork check-in: 532a2581c9 user: matt tags: v1.80

Modified db.scm from [3353e0f2ec] to [78fbf3122c].

︙
2313
2314
2315
2316
2317
2318
2319



2320
2321
2322
2323
2324
2325
2326

2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329








+
+
+









;; ;; speed up for common cases with a little logic
;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
;;      NOTE: run-id is not used
;; ;;
(define (db:test-set-state-status dbstruct run-id test-id newstate newstatus newcomment)
  (let* ((hash-key (cons run-id test-id)))
    (hash-table-delete! *db:get-test-info-by-id-cache* hash-key)
    (hash-table-delete! *db:get-test-state-status-by-id-cache*hash-key))
  (db:with-db
   dbstruct
   run-id #t
   (lambda (dbdat db)
     (db:test-set-state-status-db db run-id test-id newstate newstatus newcomment))))

(define (db:test-set-state-status-db db run-id test-id newstate newstatus newcomment)
︙
2448
2449
2450
2451
2452
2453
2454


2455
2456




2457
2458
2459
2460
2461
2462
2463
2464
2465
2466












2467
2468
2469
2470
2471
2472
2473

2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465










2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484








+
+


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








   #f
   (lambda (dbdat db)
     (sqlite3:first-result
      db
      "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;")
     run-id)))

(define *db:get-test-id-cache* (make-hash-table))

;; map run-id, testname item-path to test-id
(define (db:get-test-id dbstruct run-id testname item-path)
  (let* ((hash-key    (list run-id testname item-path))
	 (cache-result (hash-table-ref/default *db:get-test-id-cache* hash-key #f)))
    (if cache-result
	(cdr cache-result)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (dbdat db)
     (db:first-result-default
      db
      "SELECT id FROM tests WHERE testname=? AND item_path=? AND run_id=?;"
      #f ;; the default
      testname item-path run-id))))
	(let* ((res (db:with-db
		     dbstruct
		     run-id
		     #f
		     (lambda (dbdat db)
		       (db:first-result-default
			db
			"SELECT id FROM tests WHERE testname=? AND item_path=? AND run_id=?;"
			#f ;; the default
			testname item-path run-id)))))
	  (if res (hash-table-set! *db:get-test-id-cache* hash-key (cons (current-seconds) res)))
	  res))))

;; overload the unused attemptnum field for the process id of the runscript or 
;; ezsteps step script in progress
;;
(define (db:test-set-top-process-pid dbstruct run-id test-id pid)
  (db:with-db
   dbstruct
︙
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

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








+
+



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




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








  (let* ((run-ids (db:get-all-run-ids mtdb)))
    (for-each 
     (lambda (run-id)
       (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
	 (db:prep-megatest.db-adj-test-ids (dbr:dbdat-dbh mtdb) run-id testrecs)))
     run-ids)))

(define *db:get-test-info-by-id-cache* (make-hash-table))

;; Get test data using test_id
;; 
(define (db:get-test-info-by-id dbstruct run-id test-id)
  (let* ((hash-key (cons run-id test-id))
	 (cache-result (hash-table-ref/default *db:get-test-info-by-id-cache* hash-key #f)))
    (if cache-result
	(cdr cache-result)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (dbdat 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 last-update)
	  ;;                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 last-update)))
	db
	;; (db:get-cache-stmth dbdat db
	;; 		    (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;"))
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;")
	test-id run-id)
       res))))
	(db:with-db
	 dbstruct
	 run-id
	 #f
	 (lambda (dbdat 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 last-update)
		;;                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 last-update)))
	      db
	      ;; (db:get-cache-stmth dbdat db
	      ;; 		    (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;"))
	      (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;")
	      test-id run-id)
	     (hash-table-set! *db:get-test-info-by-id-cache* hash-key res)
	     res))))))

(define *db:get-test-state-status-by-id-cache* (make-hash-table))

;; Get test state, status using test_id
;; 
(define (db:get-test-state-status-by-id dbstruct run-id test-id)
  (let* ((hash-key     (cons run-id test-id))
	 (cache-result (hash-table-ref/default *db:get-test-state-status-by-id-cache* hash-key #f)))
    (if cache-result
	(cdr cache-result)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (dbdat db)
     (let ((res   (cons #f #f)))
;;	   (stmth (db:get-cache-stmth dbdat db "SELECT state,status FROM tests WHERE id=?;")))
       (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	(lambda (state status)
	  (cons state status))
	db
	"SELECT state,status FROM tests WHERE id=? AND run_id=?;" ;; stmth try not compiling this one - yes, this fixed the bind issue
	test-id run-id)
       res))))
	(db:with-db
	 dbstruct
	 run-id
	 #f
	 (lambda (dbdat db)
	   (let ((res   (cons #f #f)))
	     ;;	   (stmth (db:get-cache-stmth dbdat db "SELECT state,status FROM tests WHERE id=?;")))
	     (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	      (lambda (state status)
		(cons state status))
	      db
	      "SELECT state,status FROM tests WHERE id=? AND run_id=?;" ;; stmth try not compiling this one - yes, this fixed the bind issue
	      test-id run-id)
	     (hash-table-set! *db:get-test-state-status-by-id-cache* hash-key (cons (current-seconds) res)) 
	     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
︙
2661
2662
2663
2664
2665
2666
2667


2668
2669
2670
2671
2672
2673






2674
2675
2676
2677
2678
2679
2680

2686
2687
2688
2689
2690
2691
2692
2693
2694






2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707








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








	      (db:keep-trying-until-true proc params (- tries 1)))
	    (begin
	      ;; (debug:print-info 0 *default-log-port* "proc never returned true, params="params)
	      (print"db:keep-trying-until-true proc never returned true, proc = " proc " params =" params " tries = " tries)
	      #f)))))
  
(define (db:get-test-info dbstruct run-id test-name item-path)
  (let* ((test-id (db:get-test-id dbstruct run-id test-name item-path)))
    (db:get-test-info-by-id dbstruct run-id test-id)))
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (dbdat db)
     (db:get-test-info-db db run-id test-name item-path))))
;;  (db:with-db
;;   dbstruct
;;   run-id
;;   #f
;;   (lambda (dbdat db)
;;     (db:get-test-info-db db run-id test-name item-path))))

(define (db:get-test-info-db db run-id test-name item-path)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (a . b)
       (set! res (apply vector a b)))
     db
︙

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