Megatest

Check-in [a4f0cd340e]
Login
Overview
Comment:Catch case where itempatt causes zero matches
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a4f0cd340e573d6aeef474c3eeed75d3b5870da2
User & Date: mrwellan on 2012-04-11 17:12:50
Other Links: manifest | tags
Context
2012-04-11
17:38
Fixed patt-list-match failing on multi wild cards check-in: 205ca47739 user: mrwellan tags: trunk
17:12
Catch case where itempatt causes zero matches check-in: a4f0cd340e user: mrwellan tags: trunk
14:19
Fixed issue where config is called with filename only and no path check-in: bd5a474d0e user: mrwellan tags: trunk
Changes

Modified runs.scm from [2ea5faddfc] to [26fc9a5dca].

268
269
270
271
272
273
274

275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
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

332
333
334
335
336
337
338
339
340
341
342
343
344
345
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
381
382
;; 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))
	     (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
	     (items       (tests:testqueue-get-items      test-record))
	     (item-path   (item-list->path itemdat)))
	(debug:print 6
		     "itemdat:     " itemdat
		     "\n  items:     " items
		     "\n  item-path: " item-path)
	(cond
	 ((not items) ;; when false the test is ok to be handed off to launch (but not before)
	  (let ((have-resources  (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running
		(prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path)))
	    ;; Don't know at this time if the test have been launched at some time in the past
	    ;; i.e. is this a re-launch?
	    (if (and have-resources
		     (null? prereqs-not-met))
		;; 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)

	  (loop (car tal)(cdr tal)))

	 ;; if items is a proc then need to run items:get-items-from-config, get the list and loop 
	 ;;    - but only do that if resources exist to kick off the job
	 ((or (procedure? items)(eq? items 'have-procedure))
	  (if (and (runs:can-run-more-tests db test-record)
		   (null? (db:get-prereqs-not-met db run-id waitons item-path)))
	      (let ((test-name (tests:testqueue-get-testname test-record)))
		(setenv "MT_TEST_NAME" test-name) ;; 
		(setenv "MT_RUNNAME"   runname)
		(set-megatest-env-vars db run-id) ;; these may be needed by the launching process
		(let ((items-list (items:get-items-from-config tconfig)))
		  (if (list? items-list)
		      (begin
			(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))
	 (test-waitons (tests:testqueue-get-waitons    test-record))
	 (test-conf    (tests:testqueue-get-testconfig test-record))







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

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
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
332
333
334
335
336
337
338
339
340
341
342
343
344
345
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
381
382
383
384
;; 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)))
    (if (not (null? sorted-test-names))
	(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))
		 (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
		 (items       (tests:testqueue-get-items      test-record))
		 (item-path   (item-list->path itemdat)))
	    (debug:print 6
			 "itemdat:     " itemdat
			 "\n  items:     " items
			 "\n  item-path: " item-path)
	    (cond
	     ((not items) ;; when false the test is ok to be handed off to launch (but not before)
	      (let ((have-resources  (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running
		    (prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path)))
		;; Don't know at this time if the test have been launched at some time in the past
		;; i.e. is this a re-launch?
		(if (and have-resources
			 (null? prereqs-not-met))
		    ;; 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)
	      (if (not (null? tal))
		  (loop (car tal)(cdr tal))))

	     ;; if items is a proc then need to run items:get-items-from-config, get the list and loop 
	     ;;    - but only do that if resources exist to kick off the job
	     ((or (procedure? items)(eq? items 'have-procedure))
	      (if (and (runs:can-run-more-tests db test-record)
		       (null? (db:get-prereqs-not-met db run-id waitons item-path)))
		  (let ((test-name (tests:testqueue-get-testname test-record)))
		    (setenv "MT_TEST_NAME" test-name) ;; 
		    (setenv "MT_RUNNAME"   runname)
		    (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
		    (let ((items-list (items:get-items-from-config tconfig)))
		      (if (list? items-list)
			  (begin
			    (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))
	 (test-waitons (tests:testqueue-get-waitons    test-record))
	 (test-conf    (tests:testqueue-get-testconfig test-record))

Modified tests/Makefile from [aa72cb07fa] to [8a368d0627].

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 &







|
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
	$(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 $(RUNNAME)_itempatt -v
	$(MEGATEST) -runtests runfirst -itempatt %blahha% -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -debug 10

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 &