Megatest

Check-in [14a47fd45c]
Login
Overview
Comment:Many fixes to test running loop to support toplevel tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 14a47fd45c54a3c4aca2afebd9d5bc73024bd7df
User & Date: matt on 2012-05-04 00:07:58
Other Links: manifest | tags
Context
2012-05-04
08:41
Changed testmode into a symbol check-in: ccc8cf028b user: matt tags: trunk
00:07
Many fixes to test running loop to support toplevel tests check-in: 14a47fd45c user: matt tags: trunk
2012-05-03
18:08
Added check for having self as waiton and added a toplevel test check-in: 2c4a958ae1 user: mrwellan tags: trunk
Changes

Modified launch.scm from [f72ebdf466] to [44440a8185].

580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
      (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms) debug-param)))
     ;; (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms))))
     (else
      (if (not useshell)(debug:print 0 "WARNING: internal launching will not work well without \"useshell yes\" in your [jobtools] section"))
      (set! fullcmd (append (list remote-megatest test-sig "-execute" cmdparms) debug-param (list (if useshell "&" ""))))))
    ;; (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" "")))))
    (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm"))))
    (debug:print 1 "Launching megatest for test " test-name " in " work-area" ...")
    (test-set-status! db test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
    ;; set pre-launch-env-vars before launching, keep the vars in prevvals and put the envionment back when done
    (debug:print 4 "fullcmd: " fullcmd)
    (let* ((commonprevvals (alist->env-vars
			    (hash-table-ref/default *configdat* "env-override" '())))
	   (testprevvals   (alist->env-vars
			    (hash-table-ref/default test-conf "pre-launch-env-overrides" '())))







|







580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
      (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms) debug-param)))
     ;; (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms))))
     (else
      (if (not useshell)(debug:print 0 "WARNING: internal launching will not work well without \"useshell yes\" in your [jobtools] section"))
      (set! fullcmd (append (list remote-megatest test-sig "-execute" cmdparms) debug-param (list (if useshell "&" ""))))))
    ;; (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" "")))))
    (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm"))))
    (debug:print 1 "Launching " work-area)
    (test-set-status! db test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
    ;; set pre-launch-env-vars before launching, keep the vars in prevvals and put the envionment back when done
    (debug:print 4 "fullcmd: " fullcmd)
    (let* ((commonprevvals (alist->env-vars
			    (hash-table-ref/default *configdat* "env-override" '())))
	   (testprevvals   (alist->env-vars
			    (hash-table-ref/default test-conf "pre-launch-env-overrides" '())))

Modified runs.scm from [0f286135b8] to [a388049900].

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

	  (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))
		 (newtal      (append tal (list hed)))
		 (calc-fails  (lambda (prereqs-not-met)
				(filter (lambda (test)
					  (debug:print 9 "test: " test)
					  (and (vector? test) ;; not (string? test))

					       (not (member (db:test-get-status test)
							    '("PASS" "WARN" "CHECK" "WAIVED")))))
					prereqs-not-met))))












	    (debug:print 6
			 "itemdat:     " itemdat
			 "\n  items:     " items
			 "\n  item-path: " item-path
			 "\n  waitons:   " waitons)

	    ;; check for hed in waitons => this would be circular, remove it and issue an
	    ;; error
	    (if (member hed waitons)
		(begin
		  (debug:print 0 "ERROR: test " hed " has listed itself as a waiton, please correct this!")
		  (set! waiton (filter (lambda (x)(not (equal? x hed))) waitons))))

	    (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 mode: (config-lookup tconfig "requirements" "testmode")))
		     (fails           (calc-fails prereqs-not-met)))

		(debug:print 8 "INFO: have-resources: " have-resources " prereqs-not-met: " prereqs-not-met " fails: " fails)




		;; 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?
		(cond
		 ((and have-resources
		       (null? prereqs-not-met))


		  ;; no loop here, just 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
		  ;; but should check if it is due to lack of resources vs. prerequisites
		  )







>


>
>










>


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
















|
|
>
|
>
>
>
>




|
>
>







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
    ;; 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! 0.1) ;; 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 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
		 (items       (tests:testqueue-get-items      test-record))
		 (item-path   (item-list->path itemdat))
		 (newtal      (append tal (list hed)))
		 (calc-fails  (lambda (prereqs-not-met)
				(filter (lambda (test)
					  (debug:print 9 "test: " test)
					  (and (vector? test) ;; not (string? test))
					       (equal? (db:test-get-state test) "COMPLETED")
					       (not (member (db:test-get-status test)
							    '("PASS" "WARN" "CHECK" "WAIVED")))))
					prereqs-not-met)))
		 (calc-not-completed (lambda (prereqs-not-met)
				       (filter
					(lambda (t)
					  (or (not (vector? t))
					      (not (equal? "COMPLETED" (db:test-get-state t)))))
					prereqs-not-met)))
		 (pretty-string (lambda (lst)
				  (map (lambda (t)
					 (if (string? t)
					     t
					     (conc (db:test-get-testname t) ":" (db:test-get-state t) "/" (db:test-get-status t))))
				       lst))))
	    (debug:print 6
			 "itemdat:     " itemdat
			 "\n  items:     " items
			 "\n  item-path: " item-path
			 "\n  waitons:   " waitons)

	    ;; check for hed in waitons => this would be circular, remove it and issue an
	    ;; error
	    (if (member hed waitons)
		(begin
		  (debug:print 0 "ERROR: test " hed " has listed itself as a waiton, please correct this!")
		  (set! waiton (filter (lambda (x)(not (equal? x hed))) waitons))))

	    (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 mode: testmode))
		     (fails           (calc-fails prereqs-not-met))
		     (non-completed   (calc-not-completed prereqs-not-met)))
		(debug:print 8 "INFO: have-resources: " have-resources " prereqs-not-met: " 
			     (string-intersperse 
			      (map (lambda (t)
				     (conc (db:test-get-state t)"/"(db:test-get-status t)))
				   prereqs-not-met) ", ") " fails: " fails)
		;; 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?
		(cond
		 ((and have-resources
		       (or (null? prereqs-not-met)
			   (and (eq? testmode 'toplevel)
				(null? non-completed))))
		  ;; no loop here, just 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
		  ;; but should check if it is due to lack of resources vs. prerequisites
		  )
378
379
380
381
382
383
384
385

386
387

388
389

390
391
392



393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409

410
411
412
413
414





415
416
417
418
419
420
421
	       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))
	      (let* ((can-run-more    (runs:can-run-more-tests db test-record))

		     (prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path mode: (config-lookup tconfig "requirements" "testmode")))
		     (fails           (calc-fails prereqs-not-met)))

		(debug:print 8 "INFO: can-run-more: " can-run-more
			     " prereqs-not-met:\n  " (intersperse prereqs-not-met "\n")

			     " fails:\n "            (intersperse fails "\n"))
		(cond 
		 ((and can-run-more (null? prereqs-not-met))



		  (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))))))
		 ((and can-run-more (null? fails))
		  (debug:print 4 "INFO: Can't run more right now, killing a little time ...")
		  (thread-sleep! 3.0)
		  (loop (car newtal)(cdr newtal))) ;; an issue with prereqs not yet met?
		 (else

		  (debug:print 1 "INFO: test "  hed " has failed prerequisite(s); "
			       (string-intersperse (map db:test-get-testname fails) ", ")
			       ", removing it from to-do list")
		  (if (not (null? tal))
		      (loop (car tal)(cdr tal)))))))





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







|
>
|
|
>
|
|
>
|
|
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
|
<
>
|
|
|
|
|
>
>
>
>
>







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434


435

436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
	       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))
	      (let ((can-run-more    (runs:can-run-more-tests db test-record)))
		(if can-run-more
		    (let* ((prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path mode: testmode))
			   (fails           (calc-fails prereqs-not-met))
			   (non-completed   (calc-not-completed prereqs-not-met)))
		      (debug:print 8 "INFO: can-run-more: " can-run-more
				   "\n prereqs-not-met: " (pretty-string prereqs-not-met)
				   "\n non-completed:   " (pretty-string non-completed) 
				   "\n fails:           " (pretty-string fails))
		      (cond 
		       ((or (null? prereqs-not-met) ;; all prereqs met, fire off the test
			    ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch
			    (and (eq? testmode 'toplevel)
				 (null? non-completed)))
			(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))))))
		       ((null? fails)


			(loop (car newtal)(cdr newtal))) ;; an issue with prereqs not yet met?

		       ((and (not (null? fails))(eq? testmode 'normal))
			(debug:print 1 "INFO: test "  hed " (mode=" testmode ") has failed prerequisite(s); "
				     (string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ")
				     ", removing it from to-do list")
			(if (not (null? tal))
			    (loop (car tal)(cdr tal))))
		       (else
			(debug:print 8 "ERROR: No handler for this condition, hed: " hed " fails: " (string-intersperse (map db:test-get-testname fails) ",") " testmode: " testmode " prereqs-not-met: " (pretty-string prereqs-not-met))
			(loop (car newtal)(cdr newtal)))))
		    ;; if can't run more just loop with next possible test
		    (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

Modified tests/fullrun/tests/all_toplevel/testconfig from [399494b151] to [215d3ef1af].

1
2
3
4
5


6
7
[ezsteps]
calcresults megatest -list-runs $MT_RUNNAME -target $MT_TARGET

[requirements]
waiton all_toplevel exit_0 exit_1 ez_exit2_fail ez_fail ez_pass ezlog_fail ezlog_fail_then_pass ezlog_pass ezlog_warn lineitem_fail lineitem_pass logpro_required_fail manual_example neverrun priority_1 priority_10 priority_10_waiton_1 priority_2 priority_3 priority_4 priority_5 priority_6 priority_7 priority_8 priority_9 runfirst singletest singletest2 sqlitespeed test_mt_vars 


# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
mode toplevel




|
>
>


1
2
3
4
5
6
7
8
9
[ezsteps]
calcresults megatest -list-runs $MT_RUNNAME -target $MT_TARGET

[requirements]
waiton all_toplevel exit_0 exit_1 ez_exit2_fail ez_fail ez_pass ezlog_fail ezlog_fail_then_pass ezlog_pass ezlog_warn lineitem_fail lineitem_pass logpro_required_fail 
# manual_example neverrun priority_1 priority_10 priority_10_waiton_1 priority_2 priority_3 priority_4 priority_5 priority_6 priority_7 priority_8 priority_9 runfirst singletest singletest2 sqlitespeed test_mt_vars 

# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
mode toplevel