Overview
Comment: | Mostly added contour support to db |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | run-mgr |
Files: | files | file ages | folders |
SHA1: |
eeedb3f97304e442cb23634e0aa21482 |
User & Date: | matt on 2017-02-14 01:19:37 |
Other Links: | branch diff | manifest | tags |
Context
2017-02-14
| ||
14:48 | Minor tweaks check-in: 073579372e user: mrwellan tags: run-mgr | |
01:19 | Mostly added contour support to db check-in: eeedb3f973 user: matt tags: run-mgr | |
2017-02-13
| ||
23:58 | Added basics of -contour support. db still needed, also some other changes in this commit. check-in: 0f4fa8cf1a user: matt tags: run-mgr | |
Changes
Modified db.scm from [cf38571740] to [ddf31ee975].
︙ | ︙ | |||
706 707 708 709 710 711 712 | ) '("tests" "test_steps" "test_data"))) (define (db:patch-schema-maindb maindb) ;; ;; remove all these some time after september 2016 (added in v1.6031 ;; | > > | | | | | | | | > > > | 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 | ) '("tests" "test_steps" "test_data"))) (define (db:patch-schema-maindb maindb) ;; ;; remove all these some time after september 2016 (added in v1.6031 ;; (for-each (lambda (column type default) (handle-exceptions exn (if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn)) (debug:print 0 *default-log-port* "Column " column " already added to runs table") (db:general-sqlite-error-dump exn "alter table runs ..." #f "none")) (sqlite3:execute maindb (conc "ALTER TABLE runs ADD COLUMN " column " " type " DEFAULT " default)))) (list "last_update" "contour") (list "INTEGER" "TEXT" ) (list "0" "''" )) ;; these schema changes don't need exception handling (sqlite3:execute maindb "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs FOR EACH ROW BEGIN UPDATE runs SET last_update=(strftime('%s','now')) |
︙ | ︙ | |||
877 878 879 880 881 882 883 | ;; (if (member 'new2old options) (set! data-synced (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb) data-synced))) | | | 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 | ;; (if (member 'new2old options) (set! data-synced (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb) data-synced))) (if (member 'schema options) (begin (db:patch-schema-maindb (db:dbdat-get-db mtdb)) (db:patch-schema-maindb (db:dbdat-get-db tmpdb)) (db:patch-schema-maindb (db:dbdat-get-db refndb)) (db:patch-schema-rundb (db:dbdat-get-db mtdb)) (db:patch-schema-rundb (db:dbdat-get-db tmpdb)) (db:patch-schema-rundb (db:dbdat-get-db refndb)))) |
︙ | ︙ | |||
1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 | (for-each (lambda (key) (sqlite3:execute db "INSERT OR REPLACE INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT")) keys) (sqlite3:execute db (conc "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, \n " fieldstr (if havekeys "," "") " runname TEXT DEFAULT 'norun', state TEXT DEFAULT '', status TEXT DEFAULT '', owner TEXT DEFAULT '', event_time TIMESTAMP DEFAULT (strftime('%s','now')), comment TEXT DEFAULT '', fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, | > | 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 | (for-each (lambda (key) (sqlite3:execute db "INSERT OR REPLACE INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT")) keys) (sqlite3:execute db (conc "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, \n " fieldstr (if havekeys "," "") " runname TEXT DEFAULT 'norun', contour TEXT DEFAULT '', state TEXT DEFAULT '', status TEXT DEFAULT '', owner TEXT DEFAULT '', event_time TIMESTAMP DEFAULT (strftime('%s','now')), comment TEXT DEFAULT '', fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, |
︙ | ︙ | |||
1814 1815 1816 1817 1818 1819 1820 | patts)) comparator))) ;; register a test run with the db, this accesses the main.db and does NOT ;; use server api ;; | | | > | | | 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 | patts)) comparator))) ;; register a test run with the db, this accesses the main.db and does NOT ;; use server api ;; (define (db:register-run dbstruct keyvals runname state status user contour-in) (let* ((keys (map car keyvals)) (keystr (keys->keystr keys)) (contour (or contour-in "")) ;; empty string to force no hierarcy and be backwards compatible. (comma (if (> (length keys) 0) "," "")) (andstr (if (> (length keys) 0) " AND " "")) (valslots (keys->valslots keys)) ;; ?,?,? ... (allvals (append (list runname state status user contour) (map cadr keyvals))) (qryvals (append (list runname) (map cadr keyvals))) (key=?str (string-intersperse (map (lambda (k)(conc k "=?")) keys) " AND "))) (debug:print 3 *default-log-port* "keys: " keys " allvals: " allvals " keyvals: " keyvals " key=?str is " key=?str) (debug:print 2 *default-log-port* "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run") (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and" (db:with-db dbstruct #f #f (lambda (db) (let ((res #f)) (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time,contour" comma keystr ") VALUES (?,?,?,?,strftime('%s','now'),?" comma valslots ");") allvals) (apply sqlite3:for-each-row (lambda (id) (set! res id)) db (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");"))) qry) |
︙ | ︙ |
Modified rmt.scm from [6898f1a6b7] to [e61c38f6cb].
︙ | ︙ | |||
561 562 563 564 565 566 567 | (define (rmt:get-run-info run-id) (rmt:send-receive 'get-run-info run-id (list run-id))) (define (rmt:get-num-runs runpatt) (rmt:send-receive 'get-num-runs #f (list runpatt))) ;; Use the special run-id == #f scenario here since there is no run yet | | | | 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 | (define (rmt:get-run-info run-id) (rmt:send-receive 'get-run-info run-id (list run-id))) (define (rmt:get-num-runs runpatt) (rmt:send-receive 'get-num-runs #f (list runpatt))) ;; Use the special run-id == #f scenario here since there is no run yet (define (rmt:register-run keyvals runname state status user contour) (rmt:send-receive 'register-run #f (list keyvals runname state status user contour))) (define (rmt:get-run-name-from-id run-id) (rmt:send-receive 'get-run-name-from-id run-id (list run-id))) (define (rmt:delete-run run-id) (rmt:send-receive 'delete-run run-id (list run-id))) |
︙ | ︙ |
Modified runs.scm from [26d4a85389] to [7ed10af70d].
︙ | ︙ | |||
197 198 199 200 201 202 203 | ;; test-names: Comma separated patterns same as test-patts but used in selection ;; of tests to run. The item portions are not respected. ;; FIXME: error out if /patt specified ;; (define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names (let* ((keys (keys:config-get-fields *configdat*)) (keyvals (keys:target->keyval keys target)) | | | 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 | ;; test-names: Comma separated patterns same as test-patts but used in selection ;; of tests to run. The item portions are not respected. ;; FIXME: error out if /patt specified ;; (define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names (let* ((keys (keys:config-get-fields *configdat*)) (keyvals (keys:target->keyval keys target)) (run-id (rmt:register-run keyvals runname "new" "n/a" user (args:get-arg "-contour"))) ;; test-name))) ;; (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config")) (test-records (make-hash-table)) ;; need to process runconfigs before generating these lists (all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names (all-test-names #f) ;; (hash-table-keys all-tests-registry)) (test-names #f) ;; Generated by a call to (tests:filter-test-names all-test-names test-patts)) |
︙ | ︙ | |||
1049 1050 1051 1052 1053 1054 1055 | ;; 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) | | | 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 | ;; 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) (let* ((run-info (rmt:get-run-info run-id)) (tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path")) (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"))) |
︙ | ︙ | |||
1995 1996 1997 1998 1999 2000 2001 | ;; This could probably be refactored into one complex query ... ;; NOT PORTED - DO NOT USE YET ;; (define (runs:rollup-run keys runname user keyvals) (debug:print 4 *default-log-port* "runs:rollup-run, keys: " keys " -runname " runname " user: " user) (let* ((db #f) ;; register run operates on the main db | | | 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 | ;; This could probably be refactored into one complex query ... ;; NOT PORTED - DO NOT USE YET ;; (define (runs:rollup-run keys runname user keyvals) (debug:print 4 *default-log-port* "runs:rollup-run, keys: " keys " -runname " runname " user: " user) (let* ((db #f) ;; register run operates on the main db (new-run-id (rmt:register-run keyvals runname "new" "n/a" user (args:get-arg "-contour"))) (prev-tests (rmt:get-matching-previous-test-run-records new-run-id "%" "%")) (curr-tests (mt:get-tests-for-run new-run-id "%/%" '() '())) (curr-tests-hash (make-hash-table))) (rmt:update-run-event_time new-run-id) ;; index the already saved tests by testname and itemdat in curr-tests-hash (for-each (lambda (testdat) |
︙ | ︙ |