Megatest

Check-in [3f3d4aaa1e]
Login
Overview
Comment:Temporarily removed condition intended to catch blocking when a prerequisite is in the queue
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: 3f3d4aaa1e4b091012634ff3a11ac6ad8719c07f
User & Date: matt on 2013-09-17 08:11:19
Other Links: branch diff | manifest | tags
Context
2013-09-18
14:26
Fix for triggers run command check-in: 8986155833 user: mrwellan tags: v1.55
2013-09-17
08:11
Temporarily removed condition intended to catch blocking when a prerequisite is in the queue check-in: 3f3d4aaa1e user: matt tags: v1.55
2013-09-13
22:56
Join monitor thread in launch check-in: c84bb1b895 user: matt tags: v1.55
Changes

Modified runs.scm from [076ca20ea8] to [8981e71ea4].

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

454





455
456
457
458
459
460
461
462
463
464
465

466
467
468
469
470
471
472
473
474
475
476
477
		(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))))))

     ((and (null? fails)
	   (not (null? non-completed)))

      ;; num-retries code was here
      ;; we use this opportunity to move contents of reg to tal
      ;; but also lets check that the prerequisites are all in the newtal or reruns lists

      (let* ((allinqueue (map (lambda (x)(if (string? x) x (db:test-get-testname x)))
        		      (append newtal reruns)))

             (prereqstrs (map (lambda (x)(if (string? x) x (db:test-get-testname x)))
        		      prereqs-not-met))


             (notinqueue (filter (lambda (x)
        			   (not (member x allinqueue)))
        			 prereqstrs)))























        (if (null? notinqueue)
            (if (runs:can-keep-running? hed 5) ;; try five times
        	(begin

        	  (runs:inc-cant-run-tests hed)
        	  (list (car newtal)(append (cdr newtal) reg) '() reruns))
        	(begin

		  (if (runs:lownoise (conc "no fails prereq, null notinqueue " hed) 30)

		      (debug:print 1 "WARNING: test " hed " has no failed prerequisites but does have prerequistes that are NOT in the queue: " (string-intersperse notinqueue ", ")))





        	  (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)
        		reruns)))
	    ;; have prereqs in queue, keep going.
	    (begin
	      (if (runs:lownoise (conc "no fails prereq " hed) 30)
		  (debug:print-info 1 "no fails in prerequisites for " hed ", waiting on tests; "
				    (string-intersperse (map (lambda (x)
							       (if (string? x)
								   x

								   (runs:make-full-test-name (db:test-get-testname x)
											     (db:test-get-item-path x))))
							     non-completed) ", ")
				    ". Delaying launch of " hed "."))
	      (list (car newtal)(append (cdr newtal) reg) '() reruns))))) ;; an issue with prereqs not yet met?

     ((and (null? fails)
	   (null? non-completed))
      (if  (runs:can-keep-running? hed 5)
	  (begin
	    (runs:inc-cant-run-tests hed)
	    (debug:print-info 1 "no fails in prerequisites for " hed " but also none running, keeping " hed " for now. Try count: " (hash-table-ref/default *seen-cant-run-tests* hed 0))







<
<
<
<
<


>


>
>



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







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
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493

494
495
496
497
498
499
500
501
502
503
504
505
506
		(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))))))

     ((and (null? fails)
	   (not (null? non-completed)))





      (let* ((allinqueue (map (lambda (x)(if (string? x) x (db:test-get-testname x)))
        		      (append newtal reruns)))
	     ;; prereqstrs is a list of test names as strings that are prereqs for hed
             (prereqstrs (map (lambda (x)(if (string? x) x (db:test-get-testname x)))
        		      prereqs-not-met))
	     ;; a prereq that is not found in allinqueue will be put in the notinqueue list
	     ;; 
             (notinqueue (filter (lambda (x)
        			   (not (member x allinqueue)))
        			 prereqstrs)))
	(debug:print 1 "WARNING: test " hed " has no failed prerequisites but does have prerequistes that are NOT in the queue: " (string-intersperse notinqueue ", "))
	(debug:print-info 1 "allinqueue: " allinqueue)
	(debug:print-info 1 "prereqstrs: " prereqstrs)
	(debug:print-info 1 "notinqueue: " notinqueue)
	(debug:print-info 1 "tal:        " tal)
	(debug:print-info 1 "newtal:     " newtal)
	(debug:print-info 1 "reg:        " reg)
	(list (car newtal)(append (cdr newtal) reg) '() reruns)))

;; == ==       ;; num-retries code was here
;; == ==       ;; we use this opportunity to move contents of reg to tal
;; == ==       ;; but also lets check that the prerequisites are all in the newtal or reruns lists
;; == == 
;; == ==       (let* ((allinqueue (map (lambda (x)(if (string? x) x (db:test-get-testname x)))
;; == ==         		      (append newtal reruns)))
;; == == 	     ;; prereqstrs is a list of test names as strings that are prereqs for hed
;; == ==              (prereqstrs (map (lambda (x)(if (string? x) x (db:test-get-testname x)))
;; == ==         		      prereqs-not-met))
;; == == 	     ;; a prereq that is not found in allinqueue will be put in the notinqueue list
;; == == 	     ;; 
;; == ==              (notinqueue (filter (lambda (x)
;; == ==         			   (not (member x allinqueue)))
;; == ==         			 prereqstrs)))
;; == ==         (if (not (null? notinqueue))
;; == ==             (if (runs:can-keep-running? hed 5) ;; try five times
;; == ==         	(begin
;; == == 		  (debug:print-info 4 "increment cant-run-tests for " hed)
;; == ==         	  (runs:inc-cant-run-tests hed)
;; == ==         	  (list (car newtal)(append (cdr newtal) reg) '() reruns))
;; == ==         	(begin
;; == == 		  
;; == == 		  (if (runs:lownoise (conc "no fails prereq, null notinqueue " hed) 30)
;; == == 		      (begin
;; == == 			(debug:print 1 "WARNING: test " hed " has no failed prerequisites but does have prerequistes that are NOT in the queue: " (string-intersperse notinqueue ", "))
;; == == 			(debug:print-info 4 "allinqueue: " allinqueue)
;; == == 			(debug:print-info 4 "prereqstrs: " prereqstrs)
;; == == 			(debug:print-info 4 "notinqueue: " notinqueue)))
;; == == 		  (if (and (null? tal)(null? reg))
;; == == 		      (list (car newtal)(append (cdr newtal) reg) '() 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)
;; == == 			    reruns))))
;; == == 	    ;; have prereqs in queue, keep going.
;; == == 	    (begin
;; == == 	      (if (runs:lownoise (conc "no fails prereq " hed) 30)
;; == == 		  (debug:print-info 1 "no fails in prerequisites for " hed ", waiting on tests; "
;; == == 				    (string-intersperse (map (lambda (x)
;; == == 							       (if (string? x)

;; == == 								   x
;; == == 								   (runs:make-full-test-name (db:test-get-testname x)
;; == == 											     (db:test-get-item-path x))))
;; == == 							     non-completed) ", ")
;; == == 				    ". Delaying launch of " hed "."))
;; == == 	      (list (car newtal)(append (cdr newtal) reg) '() reruns))))) ;; an issue with prereqs not yet met?

     ((and (null? fails)
	   (null? non-completed))
      (if  (runs:can-keep-running? hed 5)
	  (begin
	    (runs:inc-cant-run-tests hed)
	    (debug:print-info 1 "no fails in prerequisites for " hed " but also none running, keeping " hed " for now. Try count: " (hash-table-ref/default *seen-cant-run-tests* hed 0))

tests/installall/config/megatest.config.dat became a symlink with target [736a5da885].

tests/installall/config/runconfigs.config.dat became a symlink with target [3b8f260acb].

Modified txtdb/txtdb.scm from [5a31465a98] to [021f48e586].

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
454




455
456
457
458
459
460
461
;; 	      #f
;; 	      (map cadr dat))))))

(define (edit-refdb path)
  ;; TEMPORARY, REMOVE IN 2014
  (if (not (file-exists? path)) ;; Create new 
      (begin
	(print "INFO: Creating new txtdb at " path)
	(create-new-db path)))
  (if (not (file-exists? (conc path "/sxml/_sheets.sxml")))
      (begin
	(print "ERROR: You appear to have the old file structure for txtdb. Please do the following and try again.")
	(print)
	(print "mv " path "/sxml/sheets.sxml " path "/sxml/_sheets.sxml")
	(print "mv " path "/sxml/workbook.sxml " path "/sxml/_workbook.sxml")
	(print)
	(print "Don't forget to remove the old files from your revision control system and add the new.")
	(exit)))
  (let* ((dbname  (pathname-strip-directory path))
	 (tmpf    (conc (create-temporary-file dbname) ".gnumeric")))
    (if (file-exists? (conc path "/sheet-names.cfg"))
	(refdb-export path tmpf))
    (let ((pid (process-run "gnumeric" (list tmpf))))
      (process-wait pid)
      (import-gnumeric-file tmpf path))))





(define (process-action action-str . param)
  (let ((num-params (length param))
	(action     (string->symbol action-str)))
    (cond
     ((eq? num-params 1)
      (case action
	((edit)







|


















>
>
>
>







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
454
455
456
457
458
459
460
461
462
463
464
465
;; 	      #f
;; 	      (map cadr dat))))))

(define (edit-refdb path)
  ;; TEMPORARY, REMOVE IN 2014
  (if (not (file-exists? path)) ;; Create new 
      (begin
	(print "\nINFO: Creating new txtdb at " path "\n")
	(create-new-db path)))
  (if (not (file-exists? (conc path "/sxml/_sheets.sxml")))
      (begin
	(print "ERROR: You appear to have the old file structure for txtdb. Please do the following and try again.")
	(print)
	(print "mv " path "/sxml/sheets.sxml " path "/sxml/_sheets.sxml")
	(print "mv " path "/sxml/workbook.sxml " path "/sxml/_workbook.sxml")
	(print)
	(print "Don't forget to remove the old files from your revision control system and add the new.")
	(exit)))
  (let* ((dbname  (pathname-strip-directory path))
	 (tmpf    (conc (create-temporary-file dbname) ".gnumeric")))
    (if (file-exists? (conc path "/sheet-names.cfg"))
	(refdb-export path tmpf))
    (let ((pid (process-run "gnumeric" (list tmpf))))
      (process-wait pid)
      (import-gnumeric-file tmpf path))))

;;======================================================================
;; This routine dispaches or executes most of the commands for refdb
;;======================================================================
;;
(define (process-action action-str . param)
  (let ((num-params (length param))
	(action     (string->symbol action-str)))
    (cond
     ((eq? num-params 1)
      (case action
	((edit)