Megatest

Check-in [bbbb4dc507]
Login
Overview
Comment:Fixed process-last-test issue
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | refactor
Files: files | file ages | folders
SHA1: bbbb4dc5079e132fc69f3497efe912c8337d0fe1
User & Date: matt on 2013-04-30 23:44:16
Other Links: branch diff | manifest | tags
Context
2013-05-01
09:39
Split run queue processing into classic and new and added control in setup section. Default is classic unless runqueue is set to a number check-in: 609ed2d8d2 user: mrwellan tags: refactor
2013-04-30
23:44
Fixed process-last-test issue check-in: bbbb4dc507 user: matt tags: refactor
22:21
Mostly working reworked loop, keeping for prosterity but will be replaced check-in: 60c6d1adb3 user: matt tags: refactor
Changes

Modified runs.scm from [d5c694d73c] to [c68e27a10b].

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

(define (runs:queue-next-reg tal reg n regful)
  (if regful
      (cdr reg)
      (if (eq? (length tal) 1)
	  '()
	  reg)))








;; 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 keyvallst flags test-patts)
    ;; 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))
	(test-registry    (make-hash-table))
	(registry-mutex   (make-mutex))
	(num-retries        0)
	(max-retries       (config-lookup *configdat* "setup" "maxretries"))
	(max-concurrent-jobs     (let ((mcj (config-lookup *configdat* "setup"     "max_concurrent_jobs")))
				    (if (and mcj (string->number mcj))
					(string->number mcj)
					1)))
	(reglen             2)) ;; length of the register queue ahead
    (set! max-retries (if (and max-retries (string->number max-retries))(string->number max-retries) 100))
    (if (not (null? sorted-test-names))
	(let loop ((hed         (car sorted-test-names))
		   (tal         (cdr sorted-test-names))
		   (reg         '()) ;; registered, put these at the head of tal 
		   (reruns      '()))
	  (if (not (null? reruns))(debug:print-info 4 "reruns=" reruns))







>
>
>
>
>
>
>















|







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

(define (runs:queue-next-reg tal reg n regful)
  (if regful
      (cdr reg)
      (if (eq? (length tal) 1)
	  '()
	  reg)))

;; (use trace)
;; (trace
;;  runs:queue-next-hed
;;  runs:queue-next-tal
;;  runs:queue-next-reg
;;  )

;; 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 keyvallst flags test-patts)
    ;; 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))
	(test-registry    (make-hash-table))
	(registry-mutex   (make-mutex))
	(num-retries        0)
	(max-retries       (config-lookup *configdat* "setup" "maxretries"))
	(max-concurrent-jobs     (let ((mcj (config-lookup *configdat* "setup"     "max_concurrent_jobs")))
				    (if (and mcj (string->number mcj))
					(string->number mcj)
					1)))
	(reglen             10)) ;; length of the register queue ahead
    (set! max-retries (if (and max-retries (string->number max-retries))(string->number max-retries) 100))
    (if (not (null? sorted-test-names))
	(let loop ((hed         (car sorted-test-names))
		   (tal         (cdr sorted-test-names))
		   (reg         '()) ;; registered, put these at the head of tal 
		   (reruns      '()))
	  (if (not (null? reruns))(debug:print-info 4 "reruns=" reruns))
459
460
461
462
463
464
465


466
467
468
469
470
471
472
473
474
475
476
477
478
479
					   (cdb:tests-register-test *runremote* run-id test-name item-path)
		        		   (mutex-lock! registry-mutex)
					   (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'done)
		        		   (mutex-unlock! registry-mutex))
		        		 (conc test-name "/" item-path))))
		    (thread-start! th))
		  (runs:shrink-can-run-more-tests-count)   ;; DELAY TWEAKER (still needed?)


		  (loop (runs:queue-next-hed tal reg reglen regfull)
			(runs:queue-next-tal tal reg reglen regfull)
			(let ((newl (append reg (list hed))))
			  (if regfull 
			      (cdr newl)
			      newl))
			reruns))
		 ;; At this point hed test registration must be completed.
		 ((eq? (hash-table-ref/default test-registry (runs:make-full-test-name test-name item-path) #f)
		       'start)
		  (debug:print-info 0 "Waiting on test registration(s): " (string-intersperse 
									   (filter (lambda (x)
										     (eq? (hash-table-ref/default test-registry x #f) 'start))
										   (hash-table-keys test-registry))







>
>
|
|
|
|
|
|
|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
					   (cdb:tests-register-test *runremote* run-id test-name item-path)
		        		   (mutex-lock! registry-mutex)
					   (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'done)
		        		   (mutex-unlock! registry-mutex))
		        		 (conc test-name "/" item-path))))
		    (thread-start! th))
		  (runs:shrink-can-run-more-tests-count)   ;; DELAY TWEAKER (still needed?)
		  (if (and (null? tal)(null? reg))
		      (loop hed tal reg reruns)
		      (loop (runs:queue-next-hed tal reg reglen regfull)
			    (runs:queue-next-tal tal reg reglen regfull)
			    (let ((newl (append reg (list hed))))
			      (if regfull 
				  (cdr newl)
				  newl))
			    reruns)))
		 ;; At this point hed test registration must be completed.
		 ((eq? (hash-table-ref/default test-registry (runs:make-full-test-name test-name item-path) #f)
		       'start)
		  (debug:print-info 0 "Waiting on test registration(s): " (string-intersperse 
									   (filter (lambda (x)
										     (eq? (hash-table-ref/default test-registry x #f) 'start))
										   (hash-table-keys test-registry))
651
652
653
654
655
656
657



658
659
660
661
662
663
664
		(set! num-retries (+ num-retries 1))
		;; (thread-sleep! (+ 1 *global-delta*))
		(if (not (null? newlst))
		    ;; since reruns have been tacked on to newlst create new reruns from junked
		    (loop (car newlst)(cdr newlst) reg (delete-duplicates junked)))))
	     ((not (null? tal))
	      (debug:print-info 4 "I'm pretty sure I shouldn't get here."))



	     (else
	      (debug:print-info 4 "Exiting loop with...\n  hed=" hed "\n  tal=" tal "\n  reruns=" reruns))
	     )))) ;; LET* ((test-record

    ;; we get here on "drop through" - loop for next test in queue
    ;; FIXME!!!! THIS SHOULD NOT REQUIRE AN EXIT!!!!!!!
    







>
>
>







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
		(set! num-retries (+ num-retries 1))
		;; (thread-sleep! (+ 1 *global-delta*))
		(if (not (null? newlst))
		    ;; since reruns have been tacked on to newlst create new reruns from junked
		    (loop (car newlst)(cdr newlst) reg (delete-duplicates junked)))))
	     ((not (null? tal))
	      (debug:print-info 4 "I'm pretty sure I shouldn't get here."))
	     ((not (null? reg)) ;; could we get here with leftovers?
	      (debug:print-info 0 "Have leftovers!")
	      (loop (car reg)(cdr reg) '() reruns))
	     (else
	      (debug:print-info 4 "Exiting loop with...\n  hed=" hed "\n  tal=" tal "\n  reruns=" reruns))
	     )))) ;; LET* ((test-record

    ;; we get here on "drop through" - loop for next test in queue
    ;; FIXME!!!! THIS SHOULD NOT REQUIRE AN EXIT!!!!!!!