Overview
Comment: | Attempt to merge all across. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | v1.70-defunct |
Files: | files | file ages | folders |
SHA1: |
5e97f1179511c6d802106381bf6e26e6 |
User & Date: | mrwellan on 2020-10-04 02:21:13 |
Other Links: | branch diff | manifest | tags |
Context
2020-10-04
| ||
02:21 | Attempt to merge all across. Closed-Leaf check-in: 5e97f11795 user: mrwellan tags: v1.70-defunct | |
2020-10-03
| ||
22:25 | Fixed merge related issues. check-in: acb5b0b2be user: mrwellan tags: v1.70-defunct | |
Changes
Modified db.scm from [900db7dda7] to [2415d6246d].
︙ | ︙ | |||
1291 1292 1293 1294 1295 1296 1297 | (define (db:drop-trigger db tbl-name) (let* ((trigger-name (if (equal? tbl-name "test_steps") "update_teststeps_trigger" (conc "update_" tbl-name "_trigger")))) (for-each (lambda (key) (if (equal? (car key) trigger-name) | | | 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 | (define (db:drop-trigger db tbl-name) (let* ((trigger-name (if (equal? tbl-name "test_steps") "update_teststeps_trigger" (conc "update_" tbl-name "_trigger")))) (for-each (lambda (key) (if (equal? (car key) trigger-name) (sqlite3:execute db (conc "drop trigger if exists " trigger-name)))) db:trigger-list))) (define (db:create-trigger db tbl-name) (let* ((trigger-name (if (equal? tbl-name "test_steps") "update_teststeps_trigger" (conc "update_" tbl-name "_trigger")))) (for-each (lambda (key) |
︙ | ︙ |
Modified runs.scm from [c2e599115c] to [c93f22731f].
︙ | ︙ | |||
845 846 847 848 849 850 851 852 853 854 855 856 857 858 | ;;; it has been at least 10 seconds (runs:testdat-prereqs-not-met testdat) ;; return the cached result (let* ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: mode itemmaps: itemmaps))) (runs:testdat-prereqs-not-met-set! testdat res) (runs:testdat-last-update-set! testdat (current-seconds)) res))) ;;====================================================================== ;; runs:expand-items is called by runs:run-tests-queue ;;====================================================================== ;; ;; return value of runs:expand-items is passed back to runs-tests-queue and is fed to named loop with this signature: ;; (let loop ((hed (car sorted-test-names)) ;; (tal (cdr sorted-test-names)) | > | 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 | ;;; it has been at least 10 seconds (runs:testdat-prereqs-not-met testdat) ;; return the cached result (let* ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: mode itemmaps: itemmaps))) (runs:testdat-prereqs-not-met-set! testdat res) (runs:testdat-last-update-set! testdat (current-seconds)) res))) ;;====================================================================== ;; runs:expand-items is called by runs:run-tests-queue ;;====================================================================== ;; ;; return value of runs:expand-items is passed back to runs-tests-queue and is fed to named loop with this signature: ;; (let loop ((hed (car sorted-test-names)) ;; (tal (cdr sorted-test-names)) |
︙ | ︙ | |||
872 873 874 875 876 877 878 | (runnables (runs:calc-runnable prereqs-not-met)) (unexpanded-prereqs (filter (lambda (testname) (let* ((test-rec (hash-table-ref test-records testname)) (items (tests:testqueue-get-items test-rec))) ;;(BB> "HEY " testname "=>"items) (or (procedure? items)(eq? items 'have-procedure)))) | | < < < | 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 | (runnables (runs:calc-runnable prereqs-not-met)) (unexpanded-prereqs (filter (lambda (testname) (let* ((test-rec (hash-table-ref test-records testname)) (items (tests:testqueue-get-items test-rec))) ;;(BB> "HEY " testname "=>"items) (or (procedure? items)(eq? items 'have-procedure)))) waitons))) (debug:print-info 4 *default-log-port* "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 prereq-fails: " (runs:pretty-string prereq-fails) "\n fails: " (runs:pretty-string fails) |
︙ | ︙ | |||
1461 1462 1463 1464 1465 1466 1467 | (if (> (length lst) 8)(append (take lst 3)(list "...")) lst)) ;;====================================================================== ;; runs:run-tests-queue is called by runs:run-tests ;;====================================================================== ;; ;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... > | | > | 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 | (if (> (length lst) 8)(append (take lst 3)(list "...")) lst)) ;;====================================================================== ;; runs:run-tests-queue is called by runs:run-tests ;;====================================================================== ;; ;; 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 all-tests-registry) ;; 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 *default-log-port* "test-records: " test-records ", flags: " (hash-table->alist flags)) ;; Do mark-and-find clean up of db before starting runing of quue ;; ;; (rmt:find-and-mark-incomplete) |
︙ | ︙ | |||
1677 1678 1679 1680 1681 1682 1683 | ;; ((not items) (debug:print-info 4 *default-log-port* "cond branch - " "rtq-2") (debug:print-info 4 *default-log-port* "OUTER COND: (not items)") (if (and (not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path required: required-tests)) (not (null? tal))) (loop (car tal)(cdr tal) reg reruns)) | | | < | > > | < | 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 | ;; ((not items) (debug:print-info 4 *default-log-port* "cond branch - " "rtq-2") (debug:print-info 4 *default-log-port* "OUTER COND: (not items)") (if (and (not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path required: required-tests)) (not (null? tal))) (loop (car tal)(cdr tal) reg reruns)) ;; side effect is to save the prereqs in the struct (runs:lazy-get-prereqs-not-met testdat run-id waitons hed item-path mode: testmode itemmaps: itemmaps) ;; not sure why this used to be here ;; (runs:dat-can-run-more-tests-set! runsdat (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running ;; NOTE: This does NOT actually gate here, only captures the proc to be called later ;; (if (not (runs:dat-wait-for-jobs-function runsdat)) (runs:dat-wait-for-jobs-function-set! runsdat (lambda (testdat-in) (let* ((jobgroup (runs:testdat-jobgroup testdat-in)) |
︙ | ︙ | |||
1798 1799 1800 1801 1802 1803 1804 | ;; 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)) (debug:print-info 4 *default-log-port* "cond branch - " "rtq-4") (let ((can-run-more #f)) ;; (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))) | | > | 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 | ;; 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)) (debug:print-info 4 *default-log-port* "cond branch - " "rtq-4") (let ((can-run-more #f)) ;; (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))) (if (not can-run-more) #;(and (list? can-run-more) ;; IDEA, this mechanism may have had some value, ;;; make it configurable to test pros/cons TODO (car can-run-more)) (let ((loop-list (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 reglen test-registry test-records itemmaps testdat))) (if loop-list (apply loop loop-list) |
︙ | ︙ |