Megatest

Check-in [5b8b902667]
Login
Overview
Comment:Only re-run if using the -rerun switch or -force switch (difference from old behaviour)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | waiton-broken-but-works
Files: files | file ages | folders
SHA1: 5b8b902667247dd0ab12e679f3d1e9e699b0d8b0
User & Date: mrwellan on 2011-12-05 13:03:13
Other Links: manifest | tags
Context
2011-12-05
22:46
Partial fix, now all run but won't stop check-in: 7bbcfa08c8 user: matt tags: trunk
13:03
Only re-run if using the -rerun switch or -force switch (difference from old behaviour) check-in: 5b8b902667 user: mrwellan tags: trunk, waiton-broken-but-works
12:34
Fixed bug with continuing to launch tests for a run after first pass though the list check-in: 428bbd9b36 user: mrwellan tags: trunk
Changes

Modified runs.scm from [bf2ea07774] to [82d8e33935].

279
280
281
282
283
284
285


286
287
288
289
290
291
292
		     "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)))


	    (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







>
>







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
		     "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 
		(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
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
    (debug:print 5
		 "test-config: " (hash-table->alist test-conf)
		 "\n   itemdat: " itemdat
		 )
    ;; setting itemdat to a list if it is #f
    (if (not itemdat)(set! itemdat '()))
    (set! item-path (item-list->path itemdat))
    (debug:print 1 "Attempting to launch test " test-name "/" item-path)
    (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
    (change-directory *toppath*)

    ;; Here is where the test_meta table is best updated
    (runs:update-test_meta db test-name test-conf)







|







371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
    (debug:print 5
		 "test-config: " (hash-table->alist test-conf)
		 "\n   itemdat: " itemdat
		 )
    ;; setting itemdat to a list if it is #f
    (if (not itemdat)(set! itemdat '()))
    (set! item-path (item-list->path itemdat))
    (debug:print 2 "Attempting to launch test " test-name "/" item-path)
    (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
    (change-directory *toppath*)

    ;; Here is where the test_meta table is best updated
    (runs:update-test_meta db test-name test-conf)
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
	    ;; -force, run no matter what
	    (force (set! runflag #t))
	    ;; NOT_STARTED, run no matter what
	    ((equal? (test:get-state testdat) "NOT_STARTED")(set! runflag #t))
	    ;; not -rerun and PASS, WARN or CHECK, do no run
	    ((and (or (not rerun)
		      keepgoing)

		  (member (test:get-status testdat) '("PASS" "WARN" "CHECK")))

	     (set! runflag #f))
	    ;; -rerun and status is one of the specifed, run it
	    ((and rerun
		  (let ((rerunlst (string-split rerun ","))) ;; FAIL,
		    (member (test:get-status testdat) rerunlst)))
	     (set! runflag #t))
	    ;; -keepgoing, do not rerun FAIL
	    ((and keepgoing
		  (member (test:get-status testdat) '("FAIL")))
	     (set! runflag #f))
	    ((and (not rerun)
		  (member (test:get-status testdat) '("FAIL" "n/a")))
	     (set! runflag #t))
	    (else (set! runflag #f)))
	   (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
	   (if (not runflag)
	       (if (not parent-test)
		   (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override"))

	       ;; NOTE: No longer be checking prerequisites here! Will never get here unless prereqs are
	       ;;       already met.
	       (if (not (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat flags))
		   (begin
		     (print "ERROR: Failed to launch the test. Exiting as soon as possible")
		     (set! *globalexitstatus* 1) ;; 
		     (process-signal (current-process-id) signal/kill))))))







>
|
>

















|
>







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
	    ;; -force, run no matter what
	    (force (set! runflag #t))
	    ;; NOT_STARTED, run no matter what
	    ((equal? (test:get-state testdat) "NOT_STARTED")(set! runflag #t))
	    ;; not -rerun and PASS, WARN or CHECK, do no run
	    ((and (or (not rerun)
		      keepgoing)
		  ;; Require to force re-run for COMPLETED or *anything* + PASS,WARN or CHECK
		  (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK"))
		      (member (test:get-state  testdat) '("COMPLETED")))) 
	     (set! runflag #f))
	    ;; -rerun and status is one of the specifed, run it
	    ((and rerun
		  (let ((rerunlst (string-split rerun ","))) ;; FAIL,
		    (member (test:get-status testdat) rerunlst)))
	     (set! runflag #t))
	    ;; -keepgoing, do not rerun FAIL
	    ((and keepgoing
		  (member (test:get-status testdat) '("FAIL")))
	     (set! runflag #f))
	    ((and (not rerun)
		  (member (test:get-status testdat) '("FAIL" "n/a")))
	     (set! runflag #t))
	    (else (set! runflag #f)))
	   (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
	   (if (not runflag)
	       (if (not parent-test)
		   (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"" (test:get-state testdat) 
				"\" and status \"" (test:get-status testdat) "\", use -rerun \"" (test:get-state testdat) "\" or -force to override"))
	       ;; NOTE: No longer be checking prerequisites here! Will never get here unless prereqs are
	       ;;       already met.
	       (if (not (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat flags))
		   (begin
		     (print "ERROR: Failed to launch the test. Exiting as soon as possible")
		     (set! *globalexitstatus* 1) ;; 
		     (process-signal (current-process-id) signal/kill))))))