Megatest

Check-in [ff41f9d1e7]
Login
Overview
Comment:Fixed wrong use of optional that should have been key.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-prereq-qry-freq
Files: files | file ages | folders
SHA1: ff41f9d1e7e3feec8c0c5d14cce08d9764396a3b
User & Date: matt on 2020-09-05 21:50:20
Other Links: branch diff | manifest | tags
Context
2020-09-05
21:51
Merged the prereq attempt to rate gate check-in: 9dfe6cbfa1 user: matt tags: v1.65-experiment
21:50
Fixed wrong use of optional that should have been key. Closed-Leaf check-in: ff41f9d1e7 user: matt tags: v1.65-prereq-qry-freq
13:41
Try reduced frequency queries for prereq not met. ==/3.5/0.83/PASS/1201/mars/== check-in: 275adb0d10 user: matt tags: v1.65-prereq-qry-freq
Changes

Modified db.scm from [2f649dc1fb] to [a8d9328753].

3045
3046
3047
3048
3049
3050
3051
3052

3053
3054
3055
3056
3057
3058
3059
3045
3046
3047
3048
3049
3050
3051

3052
3053
3054
3055
3056
3057
3058
3059







-
+







	  -1 "-" "-"))

;;
;; 1. cache tests-match-qry
;; 2. compile qry and store in hash
;; 3. convert for-each-row to fold
;;
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
#;(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
  (db:with-db
   dbstruct run-id #f
   (lambda (db)
     (let* ((res            '())
	    (stmt-cache      (dbr:dbstruct-stmt-cache dbstruct))
	    (stmth           (let* ((sh (db:hoh-get stmt-cache db testpatt)))
			       (or sh

Modified runs.scm from [7d76065ab9] to [8d74b4696c].

60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74







-
+







  )

(defstruct runs:testdat
  hed tal reg reruns  test-record
  test-name item-path jobgroup
  waitons testmode  newtal
  itemmaps
  (prereqs-not-met #f)
  (prereqs-not-met '())
  (last-update 0) ;; 
  )
  
;; look in the $MT_RUN_AREA_HOME/.softlocks directory for key-host-pid.softlock files
;;  - remove any that are over 3600 seconds old
;;  - if there are any that are younger than 10 seconds
;;      * sleep 10 seconds
831
832
833
834
835
836
837
838

839
840
841
842






843
844
845
846
847
848
849
831
832
833
834
835
836
837

838




839
840
841
842
843
844
845
846
847
848
849
850
851







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







;;    => review of a previously seen test is higher priority of never visited test
;; reg - list of previously visited tests
;; tal - list of never visited tests
;;   prefer next hed to be from reg than tal.

(define runs:nothing-left-in-queue-count 0)

(define (runs:lazy-get-prereqs-not-met  testdat run-id waitons hed item-path #!optional (mode '(normal))(itemmaps #f)) ;; mode: testmode itemmaps: itemmaps)
(define (runs:lazy-get-prereqs-not-met  testdat run-id waitons hed item-path #!key (mode '(normal))(itemmaps #f)) ;; mode: testmode itemmaps: itemmaps)
  (if (and (runs:testdat-prereqs-not-met testdat)
	   (< (- (current-seconds) (runs:testdat-last-update testdat)) 10)) ;; only refresh for this test if it has been at least 10 seconds
      (runs:testdat-prereqs-not-met testdat)
      (let* ((res (let ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: mode itemmaps: itemmaps)))
  (if (< (- (current-seconds) (runs:testdat-last-update testdat)) 10) ;; only refresh for this test if it has been at least 10 seconds
      (begin
	(debug:print 0 *default-log-port* "last-update=" (runs:testdat-last-update testdat) "(current-seconds)=" (current-seconds))
	(runs:testdat-prereqs-not-met testdat))
      ;;                     (rmt:get-prereqs-not-met 46     '("r1") "y1" ""       mode: '(itemmatch) itemmaps: #f) 
      (let* ((res (let ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: mode         itemmaps: itemmaps)))
		    (if (list? res)
			res
			(begin
			  (debug:print 0 *default-log-port*
				       "ERROR: rmt:get-prereqs-not-met returned non-list!\n"
				       "  res=" res " run-id=" run-id " waitons=" waitons " hed=" hed " item-path=" item-path " testmode=" mode " itemmaps=" itemmaps)
			  '())))))
1806
1807
1808
1809
1810
1811
1812
1813

1814
1815
1816
1817
1818
1819
1820
1808
1809
1810
1811
1812
1813
1814

1815
1816
1817
1818
1819
1820
1821
1822







-
+







         
	 ;; if items is a proc then need to run items:get-items-from-config, get the list and loop 
	 ;;    - but only do that if resources exist to kick off the job
	 ;; EXPAND ITEMS
	 ((or (procedure? items)(eq? items 'have-procedure))
          (debug:print-info 4 *default-log-port* "cond branch - "  "rtq-4")
	  (let ((can-run-more    #f)) ;; (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)))
	    (if (not can-run-more) #;(and (list? can-run-more)
	    (if (not can-run-more) #;(and (list? can-run-more) ;; IDEA, this mechanism may have had some value, make it configurable to test pros/cons TODO
		(car can-run-more))
		(let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps testdat))) ;; itemized test expanded here
		  (if loop-list
		      (apply loop loop-list)
                      (debug:print-info 4 *default-log-port* " -- Can't expand hed="hed)
                      )
                  )