Overview
Context
Changes
Modified db.scm
from [5d54b40bcf]
to [df365a143a].
︙ | | |
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
-
-
-
-
-
+
+
+
+
+
+
-
-
+
+
|
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(debug:print 4 "INFO: dbpath=" dbpath)
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
(if (config-lookup *configdat* "setup" "synchronous")
(begin
(debug:print 5 "INFO: Turning off pragma synchronous")
(sqlite3:execute db "PRAGMA synchronous = 0;"))
(debug:print 5 "INFO: NOT turning off pragma synchronous"))
;; (if (config-lookup *configdat* "setup" "synchronous")
;; (begin
;; (debug:print 5 "INFO: Turning off pragma synchronous")
;; (sqlite3:execute db "PRAGMA synchronous = 0;"))
;; (debug:print 5 "INFO: NOT turning off pragma synchronous"))
db))
(define (open-run-close proc idb . params)
(let* ((db (if idb idb (open-db)))
(res (apply proc db params)))
(if (not idb)(sqlite3:finalize! db))
res))
(define *global-delta* 0)
(define (open-run-close-measure proc idb . params)
(let* ((start-ms (current-milliseconds))
(db (if idb idb (open-db)))
(res (apply proc db params)))
(if (not idb)(sqlite3:finalize! db))
;; scale by 10, average with current value.
(set! *global-delta* (- (current-milliseconds) start-ms))
(print "INFO: delta=" *global-delta*)
(set! *global-delta* (/ (+ *global-delta* (/ (- (current-milliseconds) start-ms) 100)) 2))
(debug:print 4 "INFO: delta=" *global-delta*)
res))
(define (db:initialize db)
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(keys (config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
|
︙ | | |
Modified runs.scm
from [cf939585e7]
to [51a2b4e7e4].
︙ | | |
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
-
+
|
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 "test-records: " test-records ", keyvallst: " keyvallst " flags: " (hash-table->alist flags))
(let ((sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(item-patts (hash-table-ref/default flags "-itempatt" #f)))
(if (not (null? sorted-test-names))
(let loop ((hed (car sorted-test-names))
(tal (cdr sorted-test-names)))
(thread-sleep! (/ *global-delta* 10)) ;; give other applications some time with the db
(thread-sleep! *global-delta*) ;; give other applications some time with the db
(let* ((test-record (hash-table-ref test-records hed))
(tconfig (tests:testqueue-get-testconfig test-record))
(testmode (let ((m (config-lookup tconfig "requirements" "mode")))
(if m (string->symbol m) 'normal)))
(waitons (tests:testqueue-get-waitons test-record))
(priority (tests:testqueue-get-priority test-record))
(itemdat (tests:testqueue-get-itemdat test-record)) ;; itemdat can be a string, list or #f
|
︙ | | |
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
|
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
|
-
+
-
+
+
-
-
+
+
+
|
(if (patt-list-match item-path item-patts)
(run:test run-id runname keyvallst test-record flags #f)
(debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts))
;; else the run is stuck, temporarily or permanently
;; but should check if it is due to lack of resources vs. prerequisites
)
((not have-resources) ;; simply try again after waiting a second
(thread-sleep! (* *global-delta* *global-delta*))
(thread-sleep! (+ 1 *global-delta*))
(debug:print 1 "INFO: no resources to run new tests, waiting ...")
;; could have done hed tal here but doing car/cdr of newtal to rotate tests
(loop (car newtal)(cdr newtal)))
(else ;; must be we have unmet prerequisites
(debug:print 4 "FAILS: " fails)
;; If one or more of the prereqs-not-met are FAIL then we can issue
;; a message and drop hed from the items to be processed.
(if (null? fails)
(begin
;; couldn't run, take a breather
(debug:print 4 "INFO: Shouldn't really get here, race condition? Unable to launch more tests at this moment, killing time ...")
(thread-sleep! (* *global-delta* *global-delta*)) ;; long sleep here - no resources, may as well be patient
(thread-sleep! (+ 1 *global-delta*)) ;; long sleep here - no resources, may as well be patient
;; we made new tal by sticking hed at the back of the list
(loop (car newtal)(cdr newtal)))
;; the waiton is FAIL so no point in trying to run hed ever again
(if (not (null? tal))
(begin
(if (vector? hed)
(debug:print 1 "WARN: Dropping test " (db:test-get-testname hed) "/" (db:test-get-item-path hed)
" from the launch list as it has prerequistes that are FAIL")
(debug:print 1 "WARN: Dropping test " (db:test-get-testname hed) "/" (db:test-get-item-path hed)
" from the launch list as it has prerequistes that are FAIL")
(debug:print 1 "WARN: Dropping test " hed " as it has prerequistes that are FAIL. (NOTE: hed is not a vector)"))
(loop (car tal)(cdr tal)))))))))
;; case where an items came in as a list been processed
((and (list? items) ;; thus we know our items are already calculated
(not itemdat)) ;; and not yet expanded into the list of things to be done
(if (and (>= *verbosity* 1)
(> (length items) 0)
|
︙ | | |
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
|
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
|
-
+
|
(thread-sleep! 0.5)
;; FIXME! This harsh exit should not be necessary....
(if (not *runremote*)(exit)) ;;
#f) ;; return a #f as a hint that we are done
;; Here we need to check that all the tests remaining to be run are eligible to run
;; and are not blocked by failed
(let ((newlst (open-run-close tests:filter-non-runnable #f run-id tal test-records))) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
(thread-sleep! (/ *global-delta* 10))
(thread-sleep! *global-delta*)
(if (not (null? newlst))
(loop (car newlst)(cdr newlst)))))))))
;; parent-test is there as a placeholder for when parent-tests can be run as a setup step
(define (run:test run-id runname keyvallst test-record flags parent-test)
;; All these vars might be referenced by the testconfig file reader
(let* ((test-name (tests:testqueue-get-testname test-record))
|
︙ | | |
Modified tests/Makefile
from [283dcbd27b]
to [e9a29fafd8].
︙ | | |
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
-
+
|
test2 : fullprep
cd fullrun;$(MEGATEST) -runtests ez_pass -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_a $(SERVER)
test3 : fullprep
cd fullrun;$(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10
test4 : fullprep
cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER)
cd fullrun;$(MEGATEST) -debug 10 -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER)
test5 : fullprep
cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_aa -v $(SERVER) 2&>1 aa.log &
cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ab -v $(SERVER) 2&>1 ab.log &
cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ac -v $(SERVER) 2&>1 ac.log &
cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ad -v $(SERVER) 2&>1 ad.log &
cd fullrun;$(MEGATEST) -runtests runfirst -itempatt %/1 -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -v
|
︙ | | |