Megatest

Check-in [a160c138d8]
Login
Overview
Comment:Cache testdat. Not sure yet this is a good idea but it sure cuts down on queries that seem unnecessary.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-experiment
Files: files | file ages | folders
SHA1: a160c138d8a43b609a09eb2999e3891be104a6c7
User & Date: matt on 2020-09-05 23:59:21
Other Links: branch diff | manifest | tags
Context
2020-09-07
11:39
Better flagging with LAUNCHING state. NOTE: itemwait subrun items are re-running when they perhaps should not. check-in: 5d2d0fddc3 user: matt tags: v1.65-experiment
2020-09-05
23:59
Cache testdat. Not sure yet this is a good idea but it sure cuts down on queries that seem unnecessary. check-in: a160c138d8 user: matt tags: v1.65-experiment
21:51
Merged the prereq attempt to rate gate check-in: 9dfe6cbfa1 user: matt tags: v1.65-experiment
Changes

Modified runs.scm from [8d74b4696c] to [f581c02f6f].

834
835
836
837
838
839
840
841
842
843
844



845
846
847
848
849
850

851
852
853
854
855
856
857
;;   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 #!key (mode '(normal))(itemmaps #f)) ;; mode: testmode 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)

			  '())))))
	(runs:testdat-prereqs-not-met-set! testdat res)
	(runs:testdat-last-update-set! testdat (current-seconds))
	res)))
	   
;;======================================================================
;; runs:expand-items is called by runs:run-tests-queue







|



>
>
>





|
>







834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
;;   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 #!key (mode '(normal))(itemmaps #f)) ;; mode: testmode 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)))
		    (debug:print 4 *default-log-port* "Get prereqs for " hed ", have " (length res)
				 " prereqs. last-update=" (runs:testdat-last-update testdat) " current-seconds=" (current-seconds)
				 " delta=" (- (current-seconds) (runs:testdat-last-update testdat)))
		    (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)
			  '())))))
	(runs:testdat-prereqs-not-met-set! testdat res)
	(runs:testdat-last-update-set! testdat (current-seconds))
	res)))
	   
;;======================================================================
;; runs:expand-items is called by runs:run-tests-queue
1464
1465
1466
1467
1468
1469
1470
1471


1472
1473
1474
1475
1476
1477
1478

;; every time though the loop increment the test/itempatt val.
;; when the min is > max-allowed and none running then force exit
;;
(define *max-tries-hash* (make-hash-table))

(define (runs:pretty-long-list lst)
   (if (> (length lst) 8)(append (take lst 3)(list "...")) lst))



;;======================================================================
;; runs:run-tests-queue is called by runs:run-tests
;;======================================================================
;;
;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in all-tests-registry)







|
>
>







1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484

;; every time though the loop increment the test/itempatt val.
;; when the min is > max-allowed and none running then force exit
;;
(define *max-tries-hash* (make-hash-table))

(define (runs:pretty-long-list lst)
  (if (> (length lst) 8)(append (take lst 3)(list "...")) lst))

(define *runs-testdat-cache* (make-hash-table)) ;; full/testname => testdat

;;======================================================================
;; runs:run-tests-queue is called by runs:run-tests
;;======================================================================
;;
;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in all-tests-registry)
1588
1589
1590
1591
1592
1593
1594
















1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609


1610
1611
1612
1613
1614
1615
1616
				   extras)
				  extras)
				'())))
	     (waitons     (delete-duplicates (append (tests:testqueue-get-waitons test-record) extra-waits) equal?))
	     (newtal      (append tal (list hed)))
	     (regfull     (>= (length reg) reglen))
	     (num-running (rmt:get-count-tests-running-for-run-id run-id #t)) ;; fastmode=yes
















	     (testdat     (make-runs:testdat
			   hed: hed
			   tal: tal
			   reg: reg
			   reruns: reruns
			   test-record: test-record
			   test-name:   test-name
			   item-path:   item-path
			   jobgroup:    jobgroup
			   waitons:     waitons
			   testmode:    testmode
			   newtal:      newtal
			   itemmaps:    itemmaps
			   ;; prereqs-not-met: prereqs-not-met
			   )))


	(runs:dat-regfull-set! runsdat regfull)
    
	(if (> num-running 0)
            (set! last-time-some-running (current-seconds)))

        (if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000)))
            (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>







1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
				   extras)
				  extras)
				'())))
	     (waitons     (delete-duplicates (append (tests:testqueue-get-waitons test-record) extra-waits) equal?))
	     (newtal      (append tal (list hed)))
	     (regfull     (>= (length reg) reglen))
	     (num-running (rmt:get-count-tests-running-for-run-id run-id #t)) ;; fastmode=yes
	     (testdat     (let ((oldtestdat (hash-table-ref/default *runs-testdat-cache* tfullname #f)))
			    (if oldtestdat
				(begin
				  (runs:testdat-hed-set!         oldtestdat hed)
				  (runs:testdat-tal-set!         oldtestdat tal)
				  (runs:testdat-reg-set!         oldtestdat reg)
				  (runs:testdat-reruns-set!      oldtestdat reruns)
				  (runs:testdat-test-record-set! oldtestdat test-record)
				  (runs:testdat-newtal-set!      oldtestdat newtal)
				  
				  (if (not (equal? (runs:testdat-waitons oldtestdat) waitons))
				      (debug:print 0 *default-log-port* " waitons changed for runs:testdat"))
				  (if (not (equal? (runs:testdat-itemmaps oldtestdat) itemmaps))
				      (debug:print 0 *default-log-port* " itemmaps changed for runs:testdat"))
				  
				  oldtestdat)
				(let ((newtestdat (make-runs:testdat
						   hed: hed
						   tal: tal
						   reg: reg
						   reruns: reruns
						   test-record: test-record
						   test-name:   test-name
						   item-path:   item-path
						   jobgroup:    jobgroup
						   waitons:     waitons
						   testmode:    testmode
						   newtal:      newtal
						   itemmaps:    itemmaps
						   ;; prereqs-not-met: prereqs-not-met
						   )))
				  (hash-table-set! *runs-testdat-cache* tfullname newtestdat)
				  newtestdat)))))
	(runs:dat-regfull-set! runsdat regfull)
    
	(if (> num-running 0)
            (set! last-time-some-running (current-seconds)))

        (if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000)))
            (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))