Megatest

Check-in [2de3c08fbd]
Login
Overview
Comment:Fixed case where dependent item was kicked off before prior items had fully completed
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | v1.36a
Files: files | file ages | folders
SHA1: 2de3c08fbdbf7e3fdea7fd19dcf8f253a1a9379c
User & Date: mrwellan on 2011-12-06 18:38:45
Other Links: manifest | tags
Context
2011-12-15
21:57
Regenerated docs check-in: 1a58827c8c user: matt tags: trunk
2011-12-06
18:38
Fixed case where dependent item was kicked off before prior items had fully completed check-in: 2de3c08fbd user: mrwellan tags: trunk, v1.36a
2011-12-05
22:52
Brutally fixed refusal to exit with a call to exit :) check-in: 3c6e3ca6c4 user: matt tags: trunk
Changes

Modified runs.scm from [dff7b1b281] to [6ee5dc7a41].

256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
					     ;; #f      ;; spare
					     )))
	    (for-each 
	     (lambda (waiton)
	       (if (and waiton (not (member waiton test-names)))
		   (begin
		     (set! required-tests (cons waiton required-tests))
		     (set! test-names (append test-names (list waiton))))))
	     waitons)
	    (let ((remtests (delete-duplicates (append waitons tal))))
	      (if (not (null? remtests))
		  (loop (car remtests)(cdr remtests)))))))

    (if (not (null? required-tests))
	(debug:print 1 "INFO: Adding " required-tests " to the run queue"))







|







256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
					     ;; #f      ;; spare
					     )))
	    (for-each 
	     (lambda (waiton)
	       (if (and waiton (not (member waiton test-names)))
		   (begin
		     (set! required-tests (cons waiton required-tests))
		     (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
	     waitons)
	    (let ((remtests (delete-duplicates (append waitons tal))))
	      (if (not (null? remtests))
		  (loop (car remtests)(cdr remtests)))))))

    (if (not (null? required-tests))
	(debug:print 1 "INFO: Adding " required-tests " to the run queue"))
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
	    (if (and have-resources
		     (null? prereqs-not-met))
		;; no loop - drop though and use the loop at the bottom 
		(run:test db run-id runname keyvallst test-record flags #f)
		;; else the run is stuck, temporarily or permanently
		(let ((newtal (append tal (list hed))))
		  ;; couldn't run, take a breather
		  (thread-sleep! 1)
		  (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 (>= *verbosity* 1)(pp items))
	  ;; (if (>= *verbosity* 5)







|







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
	    (if (and have-resources
		     (null? prereqs-not-met))
		;; no loop - drop though and use the loop at the bottom 
		(run:test db run-id runname keyvallst test-record flags #f)
		;; else the run is stuck, temporarily or permanently
		(let ((newtal (append tal (list hed))))
		  ;; couldn't run, take a breather
		  (thread-sleep! 4)
		  (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 (>= *verbosity* 1)(pp items))
	  ;; (if (>= *verbosity* 5)
341
342
343
344
345
346
347
348





349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
		     (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 (runs:can-run-more-tests db test-record)





	      (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! 1)
		(loop (car newtal)(cdr newtal)))))

	 ;; this case should not happen, added to help catch any bugs
	 ((and (list? items) itemdat)







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







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
		     (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! 1)
		(loop (car newtal)(cdr newtal)))))

	 ;; this case should not happen, added to help catch any bugs
	 ((and (list? items) itemdat)