Overview
| Comment: | Refactored nested cond in run:tests to a proc runs:expand-items |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | dev |
| Files: | files | file ages | folders |
| SHA1: |
a3eca73bd8c688e516af37602ac96b3e |
| User & Date: | matt on 2013-06-26 00:53:43 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-06-26
| ||
| 01:03 | Refactored nested cond in run:tests to a proc runs:expand-items check-in: 6f312dd5f5 user: matt tags: dev | |
| 00:53 | Refactored nested cond in run:tests to a proc runs:expand-items check-in: a3eca73bd8 user: matt tags: dev | |
|
2013-06-25
| ||
| 21:15 | Corrected order of adding items when doing expand check-in: c0ed667b5b user: mrwellan tags: dev | |
Changes
Modified runs.scm from [8b6a7fd7f9] to [db6150ddbe].
| ︙ | |||
327 328 329 330 331 332 333 334 335 336 337 338 339 340 | 327 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 419 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + |
(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
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
(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)))
(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?
((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))))))
(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
loop-list))
;; 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)
;; 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 ", flags: " (hash-table->alist flags))
(let ((run-info (cdb:remote-run db:get-run-info #f run-id))
|
| ︙ | |||
558 559 560 561 562 563 564 | 637 638 639 640 641 642 643 644 645 646 647 648 649 650 | - | (loop (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))) (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?) |
| ︙ | |||
594 595 596 597 598 599 600 601 | 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 | + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - + + | ;; (loop hed tal reg reruns)) ;; (let ((newtal (append tal (list hed)))) ;; We should discard hed as it has been expanded into it's items? ;; (loop (car newtal)(cdr newtal) reg reruns)) ;; ) (loop (car tal)(cdr tal) reg reruns)) ;; if items is a proc then need to run items:get-items-from-config, get the list and loop ;; - but only do that if resources exist to kick off the job ;; EXPAND ITEMS ((or (procedure? items)(eq? items 'have-procedure)) |
| ︙ |