Megatest

Check-in [79c3028409]
Login
Overview
Comment:Fixed running of single item. Decreased delays when can't launch tests as it was constraining launch rate unnecessarily
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 79c302840941f69e72b6c9f8c5af15ddbb5f51e0
User & Date: mrwellan on 2012-04-10 09:51:13
Other Links: manifest | tags
Context
2012-04-11
13:48
Fixed typo in summarize-tests check-in: b48eda5c31 user: mrwellan tags: trunk
2012-04-10
09:51
Fixed running of single item. Decreased delays when can't launch tests as it was constraining launch rate unnecessarily check-in: 79c3028409 user: mrwellan tags: trunk
2012-04-09
15:45
Fixed issue with remove-runs so default is to remove all if :state and :status are not specified, fixed pattern match due to glob wierdness issue with running tests based on itempatt check-in: 2dca8d8f9a user: mrwellan tags: trunk
Changes

Modified common.scm from [e7a7ac51ef] to [f5126ccab5].

67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
   (else #f)))

(define (any->number-if-possible val)
  (let ((num (any->number val)))
    (if num num val)))

(define (patt-list-match item patts)

  (if (and item patts)  ;; here we are filtering for matches with -itempatt
      (let ((res #f))   ;; look through all the item-patts if defined, format is patt1,patt2,patt3 ... wildcard is %
	(for-each 
	 (lambda (patt)
	   (if (string-match 
		(regexp (string-substitute "%" ".*" "a%b")) ;;(glob->regexp (string-translate patt "%" "*"))
		item)
	       (set! res #t)))
	 (string-split patts ","))
	res)
      #t))

;;======================================================================







>





|







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
   (else #f)))

(define (any->number-if-possible val)
  (let ((num (any->number val)))
    (if num num val)))

(define (patt-list-match item patts)
  (debug:print 8 "INFO: patt-list-match item=" item " patts=" patts)
  (if (and item patts)  ;; here we are filtering for matches with -itempatt
      (let ((res #f))   ;; look through all the item-patts if defined, format is patt1,patt2,patt3 ... wildcard is %
	(for-each 
	 (lambda (patt)
	   (if (string-match 
		(regexp (string-substitute "%" ".*" patt)) ;;(glob->regexp (string-translate patt "%" "*"))
		item)
	       (set! res #t)))
	 (string-split patts ","))
	res)
      #t))

;;======================================================================

Modified megatest.scm from [0ed2270785] to [cb79cd83f5].

376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (db target runname keys keynames keyvallst)
       (let ((flags (make-hash-table)))
	 (for-each (lambda (parm)
		     (hash-table-set! flags parm (args:get-arg parm)))
		   (list "-rerun" "-force"))
	 (runs:run-tests db
			 target
			 runname
			 (args:get-arg "-testpatt")
			 (args:get-arg "-itempatt")
			 user
			 flags)))))

;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory







|
|
|
|



|
<

|







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390

391
392
393
394
395
396
397
398
399

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (db target runname keys keynames keyvallst)
;;       (let ((flags (make-hash-table)))
;;	 (for-each (lambda (parm)
;;		     (hash-table-set! flags parm (args:get-arg parm)))
;;		   (list "-rerun" "-force" "-itempatt"))
	 (runs:run-tests db
			 target
			 runname
			 (args:get-arg "-runtests")

			 user
			 args:arg-hash)))) ;; )

;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
   "-runtests" 
   "run a test" 
   (lambda (db target runname keys keynames keyvallst)
     (runs:run-tests db
		     target
		     runname
		     (args:get-arg "-runtests")
		     (args:get-arg "-itempatt")
		     user
		     (make-hash-table)))))

;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
    (general-run-call 
     "-rollup" 







<

|







413
414
415
416
417
418
419

420
421
422
423
424
425
426
427
428
   "-runtests" 
   "run a test" 
   (lambda (db target runname keys keynames keyvallst)
     (runs:run-tests db
		     target
		     runname
		     (args:get-arg "-runtests")

		     user
		     args:arg-hash))))

;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
    (general-run-call 
     "-rollup" 

Modified runs.scm from [3c1812e6f4] to [2ea5faddfc].

156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
	  res) 
	(begin
	  (debug:print 0 "ERROR: Called without all necessary keys")
	  #f))))

;; This is a duplicate of run-tests (which has been deprecated). Use this one instead of run tests.
;; keyvals
(define (runs:run-tests db target runname test-patts item-patts user flags)
  (let* ((keys        (rdb:get-keys db))
	 (keyvallst   (keys:target->keyval keys target))
	 (run-id      (runs:register-run db keys keyvallst runname "new" "n/a" user))  ;;  test-name)))
	 (deferred    '()) ;; delay running these since they have a waiton clause
	 ;; keepgoing is the defacto modality now, will add hit-n-run a bit later
	 ;; (keepgoing   (hash-table-ref/default flags "-keepgoing" #f))
	 (test-names  '())







|







156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
	  res) 
	(begin
	  (debug:print 0 "ERROR: Called without all necessary keys")
	  #f))))

;; This is a duplicate of run-tests (which has been deprecated). Use this one instead of run tests.
;; keyvals
(define (runs:run-tests db target runname test-patts user flags)
  (let* ((keys        (rdb:get-keys db))
	 (keyvallst   (keys:target->keyval keys target))
	 (run-id      (runs:register-run db keys keyvallst runname "new" "n/a" user))  ;;  test-name)))
	 (deferred    '()) ;; delay running these since they have a waiton clause
	 ;; keepgoing is the defacto modality now, will add hit-n-run a bit later
	 ;; (keepgoing   (hash-table-ref/default flags "-keepgoing" #f))
	 (test-names  '())
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    (if *rpc:listener* (server:keep-running db))
    (debug:print 4 "INFO: All done by here")))

;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(define (runs:run-tests-queue db run-id runname test-records keyvallst flags)
    ;; At this point the list of parent tests is expanded 
    ;; NB// Should expand items here and then insert into the run queue.
  (debug:print 5 "test-records: " test-records ", keyvallst: " keyvallst)
  (let ((sorted-test-names (tests:sort-by-priority-and-waiton test-records))
	(item-patts        (hash-table-ref/default flags "-itempatt" #f)))
    (let loop (; (numtimes 0) ;; shouldn't need this
	       (hed         (car sorted-test-names))
	       (tal         (cdr sorted-test-names)))
      (let* ((test-record (hash-table-ref test-records hed))
	     (tconfig     (tests:testqueue-get-testconfig test-record))







|







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    (if *rpc:listener* (server:keep-running db))
    (debug:print 4 "INFO: All done by here")))

;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(define (runs:run-tests-queue db run-id runname test-records keyvallst flags)
    ;; At this point the list of parent tests is expanded 
    ;; 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)))
    (let loop (; (numtimes 0) ;; shouldn't need this
	       (hed         (car sorted-test-names))
	       (tal         (cdr sorted-test-names)))
      (let* ((test-record (hash-table-ref test-records hed))
	     (tconfig     (tests:testqueue-get-testconfig test-record))
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
		;; no loop - drop though and use the loop at the bottom 
		(if (patt-list-match item-path item-patts)
		    (run:test db 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
		(let ((newtal (append tal (list hed))))
		  ;; couldn't run, take a breather
		  (thread-sleep! 0.5)
		  (loop (car newtal)(cdr newtal))))))
	 
	 ;; 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)
		   (> (length (car items)) 0))
		   (pp items))
	  ;; (if (>= *verbosity* 5)
	  ;;     (begin
	  ;;       (print "items: ")     (pp (item-assoc->item-list items))
	  ;;       (print "itemstable: ")(pp (item-table->item-list itemstable))))
	  (for-each
	   (lambda (my-itemdat)
	     (let* ((new-test-record (let ((newrec (make-tests:testqueue)))
				       (vector-copy! test-record newrec)
				       newrec))
		    (my-item-path (item-list->path my-itemdat)))
	       (if (patt-list-match my-item-path item-patts)           ;; yes, we want to process this item
		   (let ((newtestname (conc 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)
		     (set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
	   items)







|



















|







297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
		;; no loop - drop though and use the loop at the bottom 
		(if (patt-list-match item-path item-patts)
		    (run:test db 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
		(let ((newtal (append tal (list hed))))
		  ;; couldn't run, take a breather
		  (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient
		  (loop (car newtal)(cdr newtal))))))
	 
	 ;; 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)
		   (> (length (car items)) 0))
		   (pp items))
	  ;; (if (>= *verbosity* 5)
	  ;;     (begin
	  ;;       (print "items: ")     (pp (item-assoc->item-list items))
	  ;;       (print "itemstable: ")(pp (item-table->item-list itemstable))))
	  (for-each
	   (lambda (my-itemdat)
	     (let* ((new-test-record (let ((newrec (make-tests:testqueue)))
				       (vector-copy! test-record newrec)
				       newrec))
		    (my-item-path (item-list->path my-itemdat)))
	       (if (patt-list-match my-item-path item-patts)           ;; yes, we want to process this item, NOTE: Should not need this check here!
		   (let ((newtestname (conc 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)
		     (set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
	   items)
346
347
348
349
350
351
352
353
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
			(tests:testqueue-set-items! test-record items-list)
			(loop hed tal))
		      (begin
			(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
			(exit 1)))))
	      (let ((newtal (append tal (list hed))))
		;; if can't run more tests, lets take a breather
		(thread-sleep! 0.5)
		(loop (car newtal)(cdr newtal)))))

	 ;; this case should not happen, added to help catch any bugs
	 ((and (list? items) itemdat)
	  (debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this")
	  (exit 1))))
	
      ;; we get here on "drop through" - loop for next test in queue
      (if (null? tal)
	  (begin
	    ;; FIXME!!!! THIS SHOULD NOT REQUIRE AN EXIT!!!!!!!
	    (debug:print 1 "INFO: All tests launched")
	    (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 (tests:filter-non-runnable db run-id tal test-records))) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
	    (thread-sleep! 0.5)
	    (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 db 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))







|



















|







346
347
348
349
350
351
352
353
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
			(tests:testqueue-set-items! test-record items-list)
			(loop hed tal))
		      (begin
			(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
			(exit 1)))))
	      (let ((newtal (append tal (list hed))))
		;; if can't run more tests, lets take a breather
		(thread-sleep! 0.1) ;; may as well wait a while for resources to free up
		(loop (car newtal)(cdr newtal)))))

	 ;; this case should not happen, added to help catch any bugs
	 ((and (list? items) itemdat)
	  (debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this")
	  (exit 1))))
	
      ;; we get here on "drop through" - loop for next test in queue
      (if (null? tal)
	  (begin
	    ;; FIXME!!!! THIS SHOULD NOT REQUIRE AN EXIT!!!!!!!
	    (debug:print 1 "INFO: All tests launched")
	    (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 (tests:filter-non-runnable db run-id tal test-records))) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
	    (thread-sleep! 0.1)
	    (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 db 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 [9f167505a4] to [aa72cb07fa].

20
21
22
23
24
25
26

27
28
29
30
31
32
33
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER)

test4 : cleanprep
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_aa -v $(SERVER) >& aa.log &
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ab -v $(SERVER) >& ab.log &
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ac -v $(SERVER) >& ac.log &
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ad -v $(SERVER) >& ad.log &	


cleanprep : ../*.scm Makefile *.config
	sqlite3 megatest.db "delete from metadat where var='SERVER';"
	mkdir -p /tmp/mt_runs /tmp/mt_links
	cd ..;make install
	$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt % -itempatt %
	$(BINPATH)/dboard -rows 15 &







>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER)

test4 : cleanprep
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_aa -v $(SERVER) >& aa.log &
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ab -v $(SERVER) >& ab.log &
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ac -v $(SERVER) >& ac.log &
	$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ad -v $(SERVER) >& ad.log &	
	$(MEGATEST) -runtests runfirst -itempatt %/1 -reqtarg ubuntu/nfs/none :runname w15.1.09.06_runfirst_1 -v

cleanprep : ../*.scm Makefile *.config
	sqlite3 megatest.db "delete from metadat where var='SERVER';"
	mkdir -p /tmp/mt_runs /tmp/mt_links
	cd ..;make install
	$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt % -itempatt %
	$(BINPATH)/dboard -rows 15 &