Megatest

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

Changes In Branch v1.80-servload2 Through [816d0a281b] Excluding Merge-Ins

This is equivalent to a diff from d15b736af8 to 816d0a281b

2023-05-22
17:21
Missed change check-in: 63f66b4145 user: matt tags: v1.80
17:03
Cherry pick b4f7, 94af, 996c, 4c12 and 95c5, attempt to move rollup out from server check-in: 6f620fe8f5 user: matt tags: v1.80-servload2
17:00
Cherry pick 1443 and 41255, caching check-in: 816d0a281b user: matt tags: v1.80-servload2
16:52
Added server parameter debug-parameter (set to -:p to profile for example). check-in: d15b736af8 user: matt tags: v1.80
12:09
Changed delay to linear function 0.25 * number of threads over 3. check-in: f42bab9286 user: matt tags: v1.80

Modified db.scm from [6611a78f7e] to [8d24fd7079].

︙
2333
2334
2335
2336
2337
2338
2339



2340
2341
2342
2343
2344
2345
2346

2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349








+
+
+









;; ;; 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)
︙
2468
2469
2470
2471
2472
2473
2474


2475
2476




2477
2478
2479
2480
2481
2482
2483
2484
2485
2486












2487
2488
2489
2490
2491
2492
2493

2471
2472
2473
2474
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








+
+


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








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

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








+
+



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




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








  (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
︙
2681
2682
2683
2684
2685
2686
2687


2688
2689
2690
2691
2692
2693






2694
2695
2696
2697
2698
2699
2700

2706
2707
2708
2709
2710
2711
2712
2713
2714






2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727








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








	      (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.154s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00