Megatest

Check-in [6d817c8583]
Login
Overview
Comment:Added code needed to fix blocking problem but problem not quite solved
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | blocking-on-FAIL-fix
Files: files | file ages | folders
SHA1: 6d817c8583dc6eaa712f549ddfd052ff2ebee764
User & Date: matt on 2012-05-03 01:07:46
Other Links: branch diff | manifest | tags
Context
2012-05-03
13:41
Fixed blocking bug (I think). Minor additions to new user manual Closed-Leaf check-in: 68f98cd6bb user: mrwellan tags: blocking-on-FAIL-fix
01:07
Added code needed to fix blocking problem but problem not quite solved check-in: 6d817c8583 user: matt tags: blocking-on-FAIL-fix
2012-05-02
14:59
Template files for new manual check-in: 9a1c98bbb1 user: mrwellan tags: blocking-on-FAIL-fix
Changes

Modified db.scm from [3009875fb4] to [898dc7e56c].

1002
1003
1004
1005
1006
1007
1008


1009
1010
1011
1012
1013
1014
1015
1016
1017

;; the new prereqs calculation, looks also at itempath if specified
;; all prereqs must be met:
;;    if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: do not convert to remote as it calls remote under the hood


;;
(define (db:get-prereqs-not-met db run-id waitons ref-item-path)
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)







>
>
|
|







1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019

;; the new prereqs calculation, looks also at itempath if specified
;; all prereqs must be met:
;;    if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: do not convert to remote as it calls remote under the hood
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;; 
(define (db:get-prereqs-not-met db run-id waitons ref-item-path #!key (mode 'normal))
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049

1050
1051
1052
1053
1054
1055
1056
		       (is-ok             (member status '("PASS" "WARN" "CHECK" "WAIVED")))
		       (same-itempath     (equal? ref-item-path item-path)))
		  (set! ever-seen #t)
		  (cond
		   ;; case 1, non-item (parent test) is 
		   ((and (equal? item-path "") ;; this is the parent test
			 is-completed
			 is-ok)
		    (set! parent-waiton-met #t))
		   ((and same-itempath
			 is-completed
			 is-ok)
		    (set! item-waiton-met #t)))))
	      tests)
	     (if (not (or parent-waiton-met item-waiton-met))
		 (set! result (append tests result)))
	     ;; if the test is not found then clearly the waiton is not met...
	     ;; (if (not ever-seen)(set! result (cons waitontest-name result)))))
	     (if (not ever-seen)(set! result (append tests result)))))

	waitons)
      (delete-duplicates result))))

(define (db:teststep-set-status! db test-id teststep-name state-in status-in item-path comment logfile)
  (debug:print 4 "test-id: " test-id " teststep-name: " teststep-name)
  (let* ((state     (check-valid-items "state" state-in))
	 (status    (check-valid-items "status" status-in)))







|



|



|


|
>







1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
		       (is-ok             (member status '("PASS" "WARN" "CHECK" "WAIVED")))
		       (same-itempath     (equal? ref-item-path item-path)))
		  (set! ever-seen #t)
		  (cond
		   ;; case 1, non-item (parent test) is 
		   ((and (equal? item-path "") ;; this is the parent test
			 is-completed
			 (or is-ok (eq? mode 'toplevel)))
		    (set! parent-waiton-met #t))
		   ((and same-itempath
			 is-completed
			 (or is-ok (eq? mode 'toplevel)))
		    (set! item-waiton-met #t)))))
	      tests)
	     (if (not (or parent-waiton-met item-waiton-met))
		 (set! result (append (if (null? tests) (list waitontest-name) tests) result)))
	     ;; if the test is not found then clearly the waiton is not met...
	     ;; (if (not ever-seen)(set! result (cons waitontest-name result)))))
	     (if (not ever-seen)
		 (set! result (append (if (null? tests)(list waitontest-name) tests) result)))))
	waitons)
      (delete-duplicates result))))

(define (db:teststep-set-status! db test-id teststep-name state-in status-in item-path comment logfile)
  (debug:print 4 "test-id: " test-id " teststep-name: " teststep-name)
  (let* ((state     (check-valid-items "state" state-in))
	 (status    (check-valid-items "status" status-in)))

Modified runs.scm from [e226f0afd7] to [b407faba37].

269
270
271
272
273
274
275
276
277
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
(define (runs:run-tests-queue db run-id runname test-records keyvallst flags)
    ;; 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))
	(item-patts        (hash-table-ref/default flags "-itempatt" #f)))
    (if (not (null? sorted-test-names))
	(let loop (; (numtimes 0) ;; shouldn't need this
		   (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)))

	    (debug:print 6
			 "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 
		    (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








		    (let ((newtal (append tal (list hed)))

			  (fails  (filter (lambda (test)(not (member (db:test-get-status test)
								     '("PASS" "WARN" "CHECK" "WAIVED"))))
					  prereqs-not-met)))
		      (debug:print 4 "FAILS: " fails)
		      ;; If one or more of the prereqs-not-met are FAIL then we can issue
		      ;; a message and drop hed from the items to be processed.
		      (if (null? fails)
			  (begin
			    ;; couldn't run, take a breather

			    (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient

			    (loop (car newtal)(cdr newtal)))
			  ;; the waiton is FAIL so no point in trying to run hed
			  (if (not (null? tal))



			      (loop (car tal)(cdr tal))))))))
	     
	     ;; case where an items came in as a list been processed
	     ((and (list? items)     ;; thus we know our items are already calculated
		   (not   itemdat)) ;; and not yet expanded into the list of things to be done
	      (if (and (>= *verbosity* 1)
		       (> (length items) 0)
		       (> (length (car items)) 0))







<
|







|
>








>


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







269
270
271
272
273
274
275

276
277
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
(define (runs:run-tests-queue db run-id runname test-records keyvallst flags)
    ;; 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))
	(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))))
	    (debug:print 6
			 "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?
		(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
		  )
		 ((not have-resources) ;; simply try again after waiting a second
		  (thread-sleep! 1.0)
		  (debug:print 1 "INFO: no resources to run new tests, waiting ...")
		  ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
		  (loop (car newtal)(cdr newtal)))
		 (else ;; must be we have unmet prerequisites
		  (let ((fails  (filter (lambda (test)
					  (and (not (string? test))
					       (not (member (db:test-get-status test)
							    '("PASS" "WARN" "CHECK" "WAIVED")))))
					prereqs-not-met)))
		    (debug:print 4 "FAILS: " fails)
		    ;; If one or more of the prereqs-not-met are FAIL then we can issue
		    ;; a message and drop hed from the items to be processed.
		    (if (null? fails)
			(begin
			  ;; couldn't run, take a breather
			  (debug:print 4 "INFO: Shouldn't really get here, race condition? Unable to launch more tests at this moment, killing time ...")
			  (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient
			  ;; we made new tal by sticking hed at the back of the list
			  (loop (car newtal)(cdr newtal)))
			;; the waiton is FAIL so no point in trying to run hed ever again
			(if (not (null? tal))
			    (begin
			      (debug:print 1 "WARN: Dropping test " (db:test-get-test-name hed) "/" (db:test-get-item-path hed)
					   " from the launch list as it has prerequistes that are FAIL")
			      (loop (car tal)(cdr tal))))))))))
	     
	     ;; case where an items came in as a list been processed
	     ((and (list? items)     ;; thus we know our items are already calculated
		   (not   itemdat)) ;; and not yet expanded into the list of things to be done
	      (if (and (>= *verbosity* 1)
		       (> (length items) 0)
		       (> (length (car items)) 0))
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
			(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)))))








		    (let ((newtal (append tal (list hed)))
			  (fails  (filter (lambda (test)
					    (not (member (db:test-get-status test)
							 '("PASS" "WARN" "CHECK" "WAIVED"))))
					  prereqs-not-met)))
		      ;; if can't run more tests, lets take a breather
		      (debug:print 4 "FAILS: " fails)
		      ;; If one or more of the prereqs-not-met are FAIL then we can issue
		      ;; a message and drop hed from the items to be processed.
		      (if (null? fails)
			  (begin
			    ;; couldn't run, take a breather
			    (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient
			    (loop (car newtal)(cdr newtal)))
			  ;; the waiton is FAIL so no point in trying to run hed
			  (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







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







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
			(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)))))
		    (if can-run-more
			(loop (car newtal)(cdr newtal)) ;; an issue with prereqs not yet met?
			(begin
			  (debug:print 1 "INFO: Can't run more right now, killing a little time ...")
			  (thread-sleep! 1.0)
			  (loop (car newtal)(cdr newtal)))))))
			
		    ;; Can't run anything right now so put the test back on the queue
		    ;; (let ((newtal (append tal (list hed)))
		    ;;       (fails  (filter (lambda (test)  ;; fails is a list of prerequisite tests that are FAIL
		    ;;     		    (not (member (db:test-get-status test)
		    ;;     				 '("PASS" "WARN" "CHECK" "WAIVED"))))
		    ;;     		  prereqs-not-met)))
		    ;;   ;; if can't run more tests, lets take a breather
		    ;;   (debug:print 4 "FAILS: " fails)
		    ;;   ;; If one or more of the prereqs-not-met are FAIL then we can issue
		    ;;   ;; a message and drop hed from the items to be processed.
		    ;;   (if (null? fails)
		    ;;       (begin
		    ;;         ;; couldn't run, take a breather
		    ;;         (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient
		    ;;         (loop (car newtal)(cdr newtal)))
		    ;;       ;; the waiton is FAIL so no point in trying to run hed
		    ;;       (if (not (null? tal))
		    ;;           (loop hed 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
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
		'NOT_STARTED
		(if testdat
		    (string->symbol (test:get-state testdat))
		    'failed-to-insert))
	((failed-to-insert)
	 (debug:print 0 "ERROR: Failed to insert the record into the db"))
	((NOT_STARTED COMPLETED)
	 (debug:print 6 "Got here, " (test:get-state testdat))
	 (let ((runflag #f))
	   (cond
	    ;; -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







<







475
476
477
478
479
480
481

482
483
484
485
486
487
488
		'NOT_STARTED
		(if testdat
		    (string->symbol (test:get-state testdat))
		    'failed-to-insert))
	((failed-to-insert)
	 (debug:print 0 "ERROR: Failed to insert the record into the db"))
	((NOT_STARTED COMPLETED)

	 (let ((runflag #f))
	   (cond
	    ;; -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

Modified tests/tests.scm from [1fcf1db45c] to [5d35d6b7ef].

131
132
133
134
135
136
137




(hash-table-set! args:arg-hash ":runname" "rollup")

(test "Remove the rollup run" #t (begin (remove-runs) #t))
(test "Rollup the run(s)" #t (begin
			       (runs:rollup-run db keys)
			       #t))










>
>
>
131
132
133
134
135
136
137
138
139
140

(hash-table-set! args:arg-hash ":runname" "rollup")

(test "Remove the rollup run" #t (begin (remove-runs) #t))
(test "Rollup the run(s)" #t (begin
			       (runs:rollup-run db keys)
			       #t))

;; ADD ME!!!! (db:get-prereqs-not-met *db* 1 '("runfirst") "" mode: 'normal)
;; ADD ME!!!! (rdb:get-tests-for-run *db* 1 "runfirst" #f '() '())