Megatest

Check-in [25def8d8a4]
Login
Overview
Comment:Added addaptive delay for database collision mitigation
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | test-specific-db
Files: files | file ages | folders
SHA1: 25def8d8a4bcedbdc9b41b71f02d290363d3f484
User & Date: matt on 2012-09-22 17:03:02
Other Links: branch diff | manifest | tags
Context
2012-09-22
17:54
Made test launch try to share the db by open as needed. check-in: cb76a6fc5d user: matt tags: test-specific-db
17:03
Added addaptive delay for database collision mitigation check-in: 25def8d8a4 user: matt tags: test-specific-db
15:14
More streamlining check-in: eccc3dc4d0 user: matt tags: test-specific-db
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
	 (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"))
    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))

    (set! *global-delta* (- (current-milliseconds) start-ms))
    (print "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))







|
|
|
|
|














>
|
|







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"))
    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* (/ (+ *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
    ;; 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
	  (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







|







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*) ;; 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
		  (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*))
		  (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
			  ;; 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

			      (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")

			      (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)







|











|





>
|
|
>







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! (+ 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! (+ 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 " 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
		(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))
		(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))







|







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*)
		(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
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)

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







|







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) -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