Overview
Comment: | Mostly working reworked loop, keeping for prosterity but will be replaced |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | refactor |
Files: | files | file ages | folders |
SHA1: |
60c6d1adb366122e87f4fb2dbdf4da7a |
User & Date: | matt on 2013-04-30 22:21:02 |
Other Links: | branch diff | manifest | tags |
Context
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 | |
21:31 | Refactor process on runs launch loop check-in: 8de570b517 user: mrwellan tags: refactor | |
Changes
Modified runs.scm from [ad0152f814] to [d5c694d73c].
︙ | ︙ | |||
319 320 321 322 323 324 325 | (conc t) (conc (db:test-get-testname t) ":" (db:test-get-state t) "/" (db:test-get-status t)))) lst)) (define (runs:make-full-test-name testname itempath) (if (equal? itempath "") testname (conc testname "/" itempath))) | | < | > | | | | | | < < | | | < < | | | > > | < | | > | 319 320 321 322 323 324 325 326 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 | (conc t) (conc (db:test-get-testname t) ":" (db:test-get-state t) "/" (db:test-get-status t)))) lst)) (define (runs:make-full-test-name testname itempath) (if (equal? itempath "") testname (conc testname "/" itempath))) (define (runs:queue-next-hed tal reg n regful) (if regful (if (null? reg) ;; doesn't make sense, this is probably NOT the problem of the car (car tal) (car reg)) (car tal))) (define (runs:queue-next-tal tal reg n regful) (if regful tal (let ((newtal (cdr tal))) (if (null? newtal) reg newtal )))) (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)) ;; (print "Top of loop, hed=" hed ", tal=" tal " ,reruns=" reruns) (let* ((test-record (hash-table-ref test-records hed)) (test-name (tests:testqueue-get-testname test-record)) (tconfig (tests:testqueue-get-testconfig test-record)) (testmode (let ((m (config-lookup tconfig "requirements" "mode"))) (if m (string->symbol m) 'normal))) (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))) (regfull (> (length reg) reglen))) ;; (if (> (length reg) 10) ;; (begin ;; (set! tal (cons hed tal)) ;; (set! hed (car reg)) ;; (set! reg (cdr reg)) ;; (set! newtal tal))) (debug:print 6 |
︙ | ︙ | |||
434 435 436 437 438 439 440 | ;; Check item path against item-patts ((not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path)) ;; This test/itempath is not to be run ;; else the run is stuck, temporarily or permanently ;; but should check if it is due to lack of resources vs. prerequisites (debug:print-info 1 "Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " test-patts) ;; (thread-sleep! *global-delta*) (if (not (null? tal)) | | | | | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 | ;; Check item path against item-patts ((not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path)) ;; This test/itempath is not to be run ;; else the run is stuck, temporarily or permanently ;; but should check if it is due to lack of resources vs. prerequisites (debug:print-info 1 "Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " test-patts) ;; (thread-sleep! *global-delta*) (if (not (null? tal)) (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) reruns))) ;; Registry has been started for this test but has not yet completed ;; this should be rare, the case where there are only a couple of tests and the db is slow ;; delay a short while and continue ;; ((eq? (hash-table-ref/default test-registry (runs:make-full-test-name test-name item-path) #f) 'start) ;; (thread-sleep! 0.01) ;; (loop (car newtal)(cdr newtal) reruns)) |
︙ | ︙ | |||
461 462 463 464 465 466 467 | (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?) | | | | > > > | 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 | (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)) |
︙ | ︙ | |||
491 492 493 494 495 496 497 | (and (eq? testmode 'toplevel) (null? non-completed)))) (run:test run-id runname keyvallst test-record flags #f) (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'running) (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (thread-sleep! *global-delta*) (if (not (null? tal)) | | | | | 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 | (and (eq? testmode 'toplevel) (null? non-completed)))) (run:test run-id runname keyvallst test-record flags #f) (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'running) (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (thread-sleep! *global-delta*) (if (not (null? tal)) (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) reruns))) (else ;; must be we have unmet prerequisites (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 |
︙ | ︙ | |||
515 516 517 518 519 520 521 | (if (vector? hed) (begin (debug:print 1 "WARN: Dropping test " (db:test-get-testname hed) "/" (db:test-get-item-path hed) " from the launch list as it has prerequistes that are FAIL") (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (thread-sleep! *global-delta*) (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'removed) | | | | | 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | (if (vector? hed) (begin (debug:print 1 "WARN: Dropping test " (db:test-get-testname hed) "/" (db:test-get-item-path hed) " from the launch list as it has prerequistes that are FAIL") (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (thread-sleep! *global-delta*) (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'removed) (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?) ;; (thread-sleep! (+ 0.01 *global-delta*)) (loop hed tal reg reruns))))))))) ;; END OF INNER COND |
︙ | ︙ | |||
550 551 552 553 554 555 556 | (hash-table-set! test-records newtestname new-test-record) (set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath items) (if (not (null? tal)) (begin (debug:print-info 4 "End of items list, looping with next after short delay") ;; (thread-sleep! (+ 0.01 *global-delta*)) | | | | | 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 | (hash-table-set! test-records newtestname new-test-record) (set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath items) (if (not (null? tal)) (begin (debug:print-info 4 "End of items list, looping with next after short delay") ;; (thread-sleep! (+ 0.01 *global-delta*)) (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) 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 ((or (procedure? items)(eq? items 'have-procedure)) (let ((can-run-more (runs:can-run-more-tests test-record max-concurrent-jobs))) (if (and (list? can-run-more) |
︙ | ︙ | |||
606 607 608 609 610 611 612 | (begin ;; TRY (if (> num-retries 100) ;; first 100 retries are low time cost ;; TRY (thread-sleep! (+ 2 *global-delta*)) ;; TRY (thread-sleep! (+ 0.01 *global-delta*))) (set! num-retries (+ num-retries 1)))) (if (> num-retries max-retries) (if (not (null? tal)) | | | | | | | | 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | (begin ;; TRY (if (> num-retries 100) ;; first 100 retries are low time cost ;; TRY (thread-sleep! (+ 2 *global-delta*)) ;; TRY (thread-sleep! (+ 0.01 *global-delta*))) (set! num-retries (+ num-retries 1)))) (if (> num-retries max-retries) (if (not (null? tal)) (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) reruns)) (loop (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 (not (null? tal)) (begin ;; (thread-sleep! *global-delta*) (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))))) (else (debug:print 8 "ERROR: No handler for this condition.") ;; TRY (thread-sleep! (+ 1 *global-delta*)) (loop (car newtal)(cdr newtal) reg reruns)))) ;; END OF IF CAN RUN MORE ;; if can't run more just loop with next possible test |
︙ | ︙ |
Modified tests/fdktestqa/testqa/tests/bigrun/testconfig from [cc46c7aa7f] to [626446c270].
1 2 3 4 5 6 7 8 9 10 11 | # Add additional steps here. Format is "stepname script" [ezsteps] step1 step1.sh # Test requirements are specified here [requirements] # waiton setup priority 0 # Iteration for your tests are controlled by the items section [items] | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # Add additional steps here. Format is "stepname script" [ezsteps] step1 step1.sh # Test requirements are specified here [requirements] # waiton setup priority 0 # Iteration for your tests are controlled by the items section [items] NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (< a 4500)(loop (+ a 1)(cons a res)) res)) >)) " ")} # test_meta is a section for storing additional data on your test [test_meta] author matt owner matt description An example test tags tagone,tagtwo |
︙ | ︙ |