Megatest

Check-in [0dc6c83d6e]
Login
Overview
Comment:Fixed performance issue with append in runs.scm
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 0dc6c83d6ebe0bb4430eb79e877059f13a204e3d
User & Date: matt on 2023-04-06 09:23:58
Other Links: branch diff | manifest | tags
Context
2023-04-06
16:25
Added asserts, improved message/assert on lock failure check-in: eca566d9f9 user: mmgraham tags: v1.80
13:32
Make server logs not overlap on server.log - this makes debug easier check-in: 3053005860 user: matt tags: v1.80
09:23
Fixed performance issue with append in runs.scm check-in: 0dc6c83d6e user: matt tags: v1.80
08:01
Fixed MTLOWEST load check-in: 71f876d389 user: matt tags: v1.80
Changes

Modified dbmod.scm from [8ac607e451] to [51b0a8133b].

231
232
233
234
235
236
237


238
239
240
241
242
243
244
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246







+
+







;; if last-update specified ("field-name" . time-in-seconds)
;;    then sync only records where field-name >= time-in-seconds
;;    IFF field-name exists
;;
;; Use (db:sync-all-tables-list keys) to get the tbls input
;;
(define (dbmod:sync-tables tbls last-update fromdb todb)
  (assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb)
  (assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb)
  (let ((stmts       (make-hash-table)) ;; table-field => stmt
	(all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	(numrecs     (make-hash-table))
	(start-time  (current-milliseconds))
	(tot-count   0))
    (for-each ;; table
     (lambda (tabledat)

Modified runs.scm from [0489d178f6] to [09906f7b93].

1541
1542
1543
1544
1545
1546
1547

1548
1549
1550
1551
1552
1553
1554
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555







+







         (registry-mutex        (make-mutex))
         (num-retries           0)
         (max-retries           (configf:lookup *configdat* "setup" "maxretries"))
         (max-concurrent-jobs   (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50))
         (reglen                (if (number? reglen-in) reglen-in 1))
         (last-time-incomplete  (- (current-seconds) 900)) ;; force at least one clean up cycle
         (last-time-some-running (current-seconds))
	 (incoming-tests        '()) ;; queue up incoming tests here to tack on to tal when it gets low
         ;; (tdbdat                (tasks:open-db))
         (runsdat (make-runs:dat
                   ;; hed: hed
                   ;; tal: tal
                   ;; reg: reg
                   ;; reruns: reruns
                   reglen: reglen
1853
1854
1855
1856
1857
1858
1859



1860

1861
1862
1863




1864
1865
1866
1867
1868
1869
1870
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863

1864
1865
1866

1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877







+
+
+
-
+


-
+
+
+
+








                                   (newtestname (db:test-make-full-name hed my-item-path)))    ;; test names are unique on testname/item-path
                              (tests:testqueue-set-items!     new-test-record #f)
                              (tests:testqueue-set-itemdat!   new-test-record my-itemdat)
                              (tests:testqueue-set-item_path! new-test-record my-item-path)
                              (hash-table-set! test-records newtestname new-test-record)
			      ;; BUG: This next line sucks up a lot of horsepower
			      ;; (set! tal (append tal (list newtestname)))
			      ;; (set! tal (cons newtestname tal)) ;; 4/6/2023 - try using cons, does it matter if the test gets added at the beginning?
			      (set! incoming-tests (cons newtestname incoming-tests))
			      (set! tal (append tal (list newtestname)))))  ;; since these are itemized create new test names testname/itempath
			      ))  ;; since these are itemized create new test names testname/itempath
                          items-in-testpatt)))
          
          
	  (if (< (length tal) 20)
	      (begin
		(set! tal (append tal (reverse incoming-tests)))
		(set! incoming-tests '())))

	  ;; At this point we have possibly added items to tal but all must be handed off to 
	  ;; INNER COND logic. I think loop without rotating the queue 
	  ;; (loop hed tal reg reruns))
	  ;; (let ((newtal (append tal (list hed))))  ;; We should discard hed as it has been expanded into it's items? Yes, but only if this *is* an itemized test
	  ;; (loop (car newtal)(cdr newtal) reg reruns)
	  (if (null? tal)