Megatest

Check-in [d3dab825b6]
Login
Overview
Comment:Cleaned up runs:expand-items
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: d3dab825b65521f4124eb3a7bb957d7b1cf3230e
User & Date: mrwellan on 2013-06-26 09:46:36
Other Links: branch diff | manifest | tags
Context
2013-06-26
09:56
Cleaned up runs:process-expanded-tests check-in: 19cefc8181 user: mrwellan tags: dev
09:46
Cleaned up runs:expand-items check-in: d3dab825b6 user: mrwellan tags: dev
01:18
Refactored nested cond in run queue processing into proc runs:process-expanded-tests check-in: 0f3b47c2b4 user: matt tags: dev
Changes

Modified runs.scm from [3077567ff2] to [7959d5d055].

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
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
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
385
386
387


388

389
390
391
392
393
394
395







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















-
-
-
-
+
+
+
+











-
-
+



+



-
+





-
-
-
-
-
-
+
+
+
+
+


-
-
+
-







(define (runs:queue-next-reg tal reg n regful)
  (if regful
      (cdr reg)
      (if (null? tal) ;; if tal is null and reg not full then '() as reg contents moved to tal
	  '()
	  reg)))

(define (runs:expand-items
(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig)
	 hed         
	 tal 
	 reg
	 reruns
	 regfull
	 newtal
	 jobgroup
	 max-concurrent-jobs
	 run-id
	 waitons
	 item-path
	 testmode
	 test-record
	 can-run-more 
	 items
	 runname
	 tconfig
	 )

  (debug:print-info 4 "INNER COND: (or (procedure? items)(eq? items 'have-procedure))")
  (let* ((loop-list       (list hed tal reg reruns))
	 (prereqs-not-met (mt:get-prereqs-not-met run-id waitons item-path mode: testmode))
	 (fails           (runs:calc-fails prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met)))
    (debug:print-info 4 "START OF INNER COND #2 "
		      "\n can-run-more:    " can-run-more
		      "\n testname:        " hed
		      "\n prereqs-not-met: " (runs:pretty-string prereqs-not-met)
		      "\n non-completed:   " (runs:pretty-string non-completed) 
		      "\n fails:           " (runs:pretty-string fails)
		      "\n testmode:        " testmode
		      "\n (eq? testmode 'toplevel): " (eq? testmode 'toplevel)
		      "\n (null? non-completed):    " (null? non-completed)
		      "\n reruns:          " reruns
		      "\n items:           " items
		      "\n can-run-more:    " can-run-more)
    ;; (thread-sleep! (+ 0.01 *global-delta*))
    (cond ;; INNER COND #2
     ((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
    (cond
     ;; all prereqs met, fire off the test
     ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch
     ((or (null? prereqs-not-met)
	  (and (eq? testmode 'toplevel)
	       (null? non-completed)))
      (debug:print-info 4 "INNER COND #2: (or (null? prereqs-not-met) (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 run-id inrunname: runname) ;; 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)
		;; (thread-sleep! *global-delta*)
		(set! loop-list (list hed tal reg reruns)))
		(list hed tal reg reruns))
	      (begin
		(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
		(exit 1))))))

     ((null? fails)
      (debug:print-info 4 "fails is null, moving on in the queue but keeping " hed " for now")
      ;; num-retries code was here
      (set! loop-list (list (car newtal)(cdr newtal) reg reruns))) ;; an issue with prereqs not yet met?
      (list (car newtal)(cdr newtal) reg reruns)) ;; an issue with prereqs not yet met?
     ((and (not (null? fails))(eq? testmode 'normal))
      (debug:print-info 1 "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 (or (not (null? reg))(not (null? tal)))
	  (begin
	    ;; (thread-sleep! *global-delta*)
	    (set! loop-list (list (runs:queue-next-hed tal reg reglen regfull)
				  (runs:queue-next-tal tal reg reglen regfull)
				  (runs:queue-next-reg tal reg reglen regfull)
				  (cons hed reruns))))))
	  (list (runs:queue-next-hed tal reg reglen regfull)
		(runs:queue-next-tal tal reg reglen regfull)
		(runs:queue-next-reg tal reg reglen regfull)
		(cons hed reruns))
	  #f)) ;; #f flags do not loop
     (else
      (debug:print 4 "ERROR: No handler for this condition.")
      ;; TRY (thread-sleep! (+ 1 *global-delta*))
      (set! loop-list (list (car newtal)(cdr newtal) reg reruns)))) ;; END OF IF CAN RUN MORE
      (list (car newtal)(cdr newtal) reg reruns)))))
    loop-list))

(define (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info)
  (let* ((run-limits-info         (runs:can-run-more-tests jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running
	 ;; (open-run-close runs:can-run-more-tests #f jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running
	 (have-resources          (car run-limits-info))
	 (num-running             (list-ref run-limits-info 1))
	 (num-running-in-jobgroup (list-ref run-limits-info 2))
546
547
548
549
550
551
552

553
554
555
556
557
558
559
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537







+







				     (runs:queue-next-tal tal reg reglen regfull)
				     (runs:queue-next-reg tal reg reglen regfull)
				     (cons hed reruns))))
		  (begin
		    (debug:print 1 "WARN: Test not processed correctly. Could be a race condition in your test implementation? " hed) ;;  " as it has prerequistes that are FAIL. (NOTE: hed is not a vector)")
		    (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?)
		    (set! loop-list (list hed tal reg reruns))))))))
    (debug:print-info 4 "runs:process-expanded-tests, loop-list=" loop-list)
    loop-list)) ;; END OF INNER COND

;; End of INNER COND for launchable test.


;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in)
685
686
687
688
689
690
691

692

693
694
695
696
697
698
699
663
664
665
666
667
668
669
670

671
672
673
674
675
676
677
678







+
-
+







	 ;;    - but only do that if resources exist to kick off the job
	 ;; EXPAND ITEMS
	 ((or (procedure? items)(eq? items 'have-procedure))
	  (let ((can-run-more    (runs:can-run-more-tests jobgroup max-concurrent-jobs)))
	    (if (and (list? can-run-more)
		     (car can-run-more))
		(let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig)))
		  (if loop-list
		  (apply loop loop-list))
		      (apply loop loop-list)))
		;; if can't run more just loop with next possible test
		(loop (car newtal)(cdr newtal) reg reruns))))
	    
	 ;; 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))

Modified tests/fullrun/megatest.config from [2867e47acf] to [2f912ec36d].

14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28







-
+







# Set launchwait to yes to use the old launch run code that waits for the launch process to return before 
# proceeding.
# launchwait yes

# If set to "default" the old code is used. Otherwise defaults to 200 or uses
# numeric value given.
#
runqueue 2
runqueue 20

# It is possible (but not recommended) to override the rsync command used
# to populate the test directories. For test development the following 
# example can be useful
#
# testcopycmd cp --remove-destination -rsv TEST_SRC_PATH/. TEST_TARG_PATH/. >> TEST_TARG_PATH/mt_launch.log 2>> TEST_TARG_PATH/mt_launch.log