Overview
Comment: | Moved runconfig.config process to earlier in flow. Changed sleep to thread-sleep. Cleaned up pre-required tests launching |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
1ff62f1f9d780d6af147a52d3ddac8f9 |
User & Date: | matt on 2011-11-01 22:30:23 |
Other Links: | manifest | tags |
Context
2011-11-01
| ||
23:00 | Improved running of predepends based on waitons check-in: 9d2d6dc7a4 user: matt tags: trunk | |
22:30 | Moved runconfig.config process to earlier in flow. Changed sleep to thread-sleep. Cleaned up pre-required tests launching check-in: 1ff62f1f9d user: matt tags: trunk | |
2011-10-30
| ||
22:04 | Corrected -load-data to -load-test-data, added manual.sh to help remember how to run this check-in: 12badb9046 user: matt tags: trunk | |
Changes
Modified db.scm from [75dcd1c1c3] to [fa70f2b097].
︙ | ︙ | |||
583 584 585 586 587 588 589 | db "UPDATE tests SET fail_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail'), pass_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') WHERE id=?;" test-id test-id test-id) ;; if the test is not FAIL then set status based on the fail and pass counts. | | | 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 | db "UPDATE tests SET fail_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail'), pass_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') WHERE id=?;" test-id test-id test-id) ;; if the test is not FAIL then set status based on the fail and pass counts. (thread-sleep! 1) (sqlite3:execute db "UPDATE tests SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 THEN 'FAIL' WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 THEN 'PASS' |
︙ | ︙ |
Modified runs.scm from [631b691194] to [621ce806fe].
︙ | ︙ | |||
541 542 543 544 545 546 547 | ;; This is original run-tests, this routine is deprecated and we will transition to using runs:run-tests (see below) ;; (define (run-tests db test-names) (let* ((keys (db-get-keys db)) (keyvallst (keys->vallist keys #t)) (run-id (register-run db keys)) ;; test-name))) | | > > > > > > | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 | ;; This is original run-tests, this routine is deprecated and we will transition to using runs:run-tests (see below) ;; (define (run-tests db test-names) (let* ((keys (db-get-keys db)) (keyvallst (keys->vallist keys #t)) (run-id (register-run db keys)) ;; test-name))) (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config"))) ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if ;; -keepgoing is specified (if (file-exists? runconfigf) (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*) (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) (if (and (eq? *passnum* 0) (args:get-arg "-keepgoing")) (begin ;; have to delete test records where NOT_STARTED since they can cause -keepgoing to ;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends ;; on test A but test B reached the point on being registered as NOT_STARTED and test ;; A failed for some reason then on re-run using -keepgoing the run can never complete. |
︙ | ︙ | |||
570 571 572 573 574 575 576 | ;; (run-waiting-tests db) (if (args:get-arg "-keepgoing") (let ((estrem (db:estimated-tests-remaining db run-id))) (if (and (> estrem 0) (eq? *globalexitstatus* 0)) (begin (debug:print 1 "Keep going, estimated " estrem " tests remaining to run, will continue in 3 seconds ...") | | | 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 | ;; (run-waiting-tests db) (if (args:get-arg "-keepgoing") (let ((estrem (db:estimated-tests-remaining db run-id))) (if (and (> estrem 0) (eq? *globalexitstatus* 0)) (begin (debug:print 1 "Keep going, estimated " estrem " tests remaining to run, will continue in 3 seconds ...") (thread-sleep! 3) (run-waiting-tests db) (loop (+ numtimes 1))))))))) ;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc (define (run-one-test db run-id test-name keyvallst) (debug:print 1 "Launching test " test-name) ;; All these vars might be referenced by the testconfig file reader |
︙ | ︙ | |||
605 606 607 608 609 610 611 | ;; put top vars into convenient variables and open the db (let* (;; db is always at *toppath*/db/megatest.db (items (hash-table-ref/default test-conf "items" '())) (itemstable (hash-table-ref/default test-conf "itemstable" '())) (allitems (if (or (not (null? items))(not (null? itemstable))) (append (item-assoc->item-list items) (item-table->item-list itemstable)) | | | | 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | ;; put top vars into convenient variables and open the db (let* (;; db is always at *toppath*/db/megatest.db (items (hash-table-ref/default test-conf "items" '())) (itemstable (hash-table-ref/default test-conf "itemstable" '())) (allitems (if (or (not (null? items))(not (null? itemstable))) (append (item-assoc->item-list items) (item-table->item-list itemstable)) '(())))) ;; a list with one null list is a test with no items ;; (runconfigf (conc *toppath* "/runconfigs.config"))) (debug:print 1 "items: ") (if (>= *verbosity* 1)(pp allitems)) (if (>= *verbosity* 5) (begin (print "items: ")(pp (item-assoc->item-list items)) (print "itestable: ")(pp (item-table->item-list itemstable)))) (if (args:get-arg "-m") |
︙ | ︙ | |||
660 661 662 663 664 665 666 | (set! testdat ts) (begin (debug:print 0 "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping") (if (not (null? tal)) (loop (car tal)(cdr tal))))))) (change-directory test-path) ;; this block is here only to inform the user early on | > > > | | | | 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 | (set! testdat ts) (begin (debug:print 0 "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping") (if (not (null? tal)) (loop (car tal)(cdr tal))))))) (change-directory test-path) ;; this block is here only to inform the user early on ;; NB// Moving the setting of runconfig.config vars to *before* the ;; the calling of each test. ;; (if (file-exists? runconfigf) ;; (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*) ;; (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) (debug:print 4 "run-id: " run-id " test-name: " test-name " item-path: " item-path " testdat: " (test:get-status testdat) " test-state: " (test:get-state testdat)) (case (if (args:get-arg "-force") 'NOT_STARTED (if testdat (string->symbol (test:get-state testdat)) 'failed-to-insert)) ((failed-to-insert) |
︙ | ︙ | |||
746 747 748 749 750 751 752 | (times (list 1))) ;; minutes to wait before trying again to kick off runs ;; BUG this hack of brute force retrying works quite well for many cases but ;; what is needed is to check the db for tests that have failed less than ;; N times or never been started and kick them off again (let loop ((waiting-test-names (hash-table-keys *waiting-queue*))) (cond ((not (runs:can-run-more-tests db)) | | | 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 | (times (list 1))) ;; minutes to wait before trying again to kick off runs ;; BUG this hack of brute force retrying works quite well for many cases but ;; what is needed is to check the db for tests that have failed less than ;; N times or never been started and kick them off again (let loop ((waiting-test-names (hash-table-keys *waiting-queue*))) (cond ((not (runs:can-run-more-tests db)) (thread-sleep! 2) (loop waiting-test-names)) ((null? waiting-test-names) (debug:print 1 "All tests launched")) (else (set! numtries (+ numtries 1)) (for-each (lambda (testname) (if (runs:can-run-more-tests db) |
︙ | ︙ | |||
869 870 871 872 873 874 875 | ;; (run-waiting-tests db) (if keepgoing (let ((estrem (db:estimated-tests-remaining db run-id))) (if (and (> estrem 0) (eq? *globalexitstatus* 0)) (begin (debug:print 1 "Keep going, estimated " estrem " tests remaining to run, will continue in 3 seconds ...") | | | 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 | ;; (run-waiting-tests db) (if keepgoing (let ((estrem (db:estimated-tests-remaining db run-id))) (if (and (> estrem 0) (eq? *globalexitstatus* 0)) (begin (debug:print 1 "Keep going, estimated " estrem " tests remaining to run, will continue in 3 seconds ...") (thread-sleep! 3) (run-waiting-tests db) (loop (+ numtimes 1))))))))) (define (run:test db run-id runname test-name keyvallst item-patts flags) (debug:print 1 "Launching test " test-name) ;; All these vars might be referenced by the testconfig file reader (setenv "MT_TEST_NAME" test-name) ;; |
︙ | ︙ | |||
907 908 909 910 911 912 913 | ;; put top vars into convenient variables and open the db (let* (;; db is always at *toppath*/db/megatest.db (items (hash-table-ref/default test-conf "items" '())) (itemstable (hash-table-ref/default test-conf "itemstable" '())) (allitems (if (or (not (null? items))(not (null? itemstable))) (append (item-assoc->item-list items) (item-table->item-list itemstable)) | | | | 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 | ;; put top vars into convenient variables and open the db (let* (;; db is always at *toppath*/db/megatest.db (items (hash-table-ref/default test-conf "items" '())) (itemstable (hash-table-ref/default test-conf "itemstable" '())) (allitems (if (or (not (null? items))(not (null? itemstable))) (append (item-assoc->item-list items) (item-table->item-list itemstable)) '(())))) ;; a list with one null list is a test with no items ;; (runconfigf (conc *toppath* "/runconfigs.config"))) (debug:print 1 "items: ") (if (>= *verbosity* 1)(pp allitems)) (if (>= *verbosity* 5) (begin (print "items: ")(pp (item-assoc->item-list items)) (print "itemstable: ")(pp (item-table->item-list itemstable)))) |
︙ | ︙ | |||
971 972 973 974 975 976 977 | (set! testdat ts) (begin (debug:print 0 "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping") (if (not (null? tal)) (loop (car tal)(cdr tal))))))) (change-directory test-path) ;; this block is here only to inform the user early on | | | | | 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 | (set! testdat ts) (begin (debug:print 0 "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping") (if (not (null? tal)) (loop (car tal)(cdr tal))))))) (change-directory test-path) ;; this block is here only to inform the user early on ;; (if (file-exists? runconfigf) ;; (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*) ;; (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) (debug:print 4 "run-id: " run-id " test-name: " test-name " item-path: " item-path " testdat: " (test:get-status testdat) " test-state: " (test:get-state testdat)) (case (if force ;; (args:get-arg "-force") 'NOT_STARTED (if testdat (string->symbol (test:get-state testdat)) 'failed-to-insert)) ((failed-to-insert) |
︙ | ︙ |