Overview
Comment: | Added function to get tests that match a tag list/pattern: tag1,tag2,tpatt% etc. (runs::get-tests-matching-tags tagpatts) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.63 |
Files: | files | file ages | folders |
SHA1: |
777bae8a540a6211e99d7afdef198230 |
User & Date: | mrwellan on 2016-12-19 22:32:54 |
Other Links: | branch diff | manifest | tags |
Context
2016-12-21
| ||
09:01 | Refactored exit process to hopefully reduce rate of stuck processes check-in: e8d5f184c1 user: mrwellan tags: v1.63 | |
2016-12-20
| ||
16:23 | added -mode and -tagexpr options Closed-Leaf check-in: 38b7f592d7 user: bjbarcla tags: v1.63-tag-mode | |
2016-12-19
| ||
22:50 | Automated merge of v1.63/777bae8a54/integ into integ-home check-in: 94d4e0a530 user: matt tags: integ-home | |
22:32 | Added function to get tests that match a tag list/pattern: tag1,tag2,tpatt% etc. (runs::get-tests-matching-tags tagpatts) check-in: 777bae8a54 user: mrwellan tags: v1.63 | |
16:51 | fixed bugs in dashboard where runs are duplicated in runs tab and statistics of summary tab check-in: 146fa45671 user: bjbarcla tags: v1.63 | |
Changes
Modified api.scm from [9a1ea8a047] to [19e6c44e9d].
︙ | ︙ | |||
37 38 39 40 41 42 43 44 45 46 47 48 49 50 | get-count-tests-running-for-run-id get-run-info get-run-status get-run-stats get-targets get-target ;; register-run get-tests-for-run get-test-id get-tests-for-runs-mindata get-run-name-from-id get-runs get-num-runs get-all-run-ids | > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | get-count-tests-running-for-run-id get-run-info get-run-status get-run-stats get-targets get-target ;; register-run get-tests-tags get-tests-for-run get-test-id get-tests-for-runs-mindata get-run-name-from-id get-runs get-num-runs get-all-run-ids |
︙ | ︙ | |||
166 167 168 169 170 171 172 173 174 175 176 177 178 179 | ((sync-inmem->db) (let ((run-id (car params))) (db:sync-touched dbstruct run-id force-sync: #t))) ((mark-incomplete) (apply db:find-and-mark-incomplete dbstruct params)) ;; TESTMETA ((testmeta-add-record) (apply db:testmeta-add-record dbstruct params)) ((testmeta-update-field) (apply db:testmeta-update-field dbstruct params)) ;; TASKS ((tasks-add) (apply tasks:add dbstruct params)) ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params)) ((tasks-get-last) (apply tasks:get-last dbstruct params)) ;; ARCHIVES | > | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 | ((sync-inmem->db) (let ((run-id (car params))) (db:sync-touched dbstruct run-id force-sync: #t))) ((mark-incomplete) (apply db:find-and-mark-incomplete dbstruct params)) ;; TESTMETA ((testmeta-add-record) (apply db:testmeta-add-record dbstruct params)) ((testmeta-update-field) (apply db:testmeta-update-field dbstruct params)) ((get-tests-tags) (db:get-tests-tags dbstruct)) ;; TASKS ((tasks-add) (apply tasks:add dbstruct params)) ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params)) ((tasks-get-last) (apply tasks:get-last dbstruct params)) ;; ARCHIVES |
︙ | ︙ |
Modified db.scm from [d719c9f795] to [ff97966612].
︙ | ︙ | |||
2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 | (string-intersperse testnames "','") "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ??? )) 0))))) ;; DEBUG FIXME - need to merge this v.155 query correctly ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?) ;; AND NOT (uname = 'n/a' AND item_path = '');" ;; done with run when: ;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING (define (db:estimated-tests-remaining dbstruct run-id) (db:with-db dbstruct run-id | > > > | 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 | (string-intersperse testnames "','") "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ??? )) 0))))) ;; DEBUG FIXME - need to merge this v.155 query correctly ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?) ;; AND NOT (uname = 'n/a' AND item_path = '');" ;; tags: '("tag%" "tag2" "%ag6") ;; ;; done with run when: ;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING (define (db:estimated-tests-remaining dbstruct run-id) (db:with-db dbstruct run-id |
︙ | ︙ | |||
3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 | "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '';" test-name) res)))) ;;====================================================================== ;; Tests meta data ;;====================================================================== ;; read the record given a testname (define (db:testmeta-get-record dbstruct testname) (let ((res #f)) (db:with-db dbstruct #f | > > > > > > > > > > > > > > > > > > > | 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 | "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '';" test-name) res)))) ;;====================================================================== ;; Tests meta data ;;====================================================================== ;; returns a hash table of tags to tests ;; (define (db:get-tests-tags dbstruct) (let* ((dbdat (db:get-db dbstruct #f)) (db (db:dbdat-get-db dbdat)) (res (make-hash-table))) (sqlite3:for-each-row (lambda (testname tags-in) (let ((tags (string-split tags-in ","))) (for-each (lambda (tag) (hash-table-set! res tag (delete-duplicates (cons testname (hash-table-ref/default res tag '()))))) tags))) db "SELECT testname,tags FROM test_meta") res)) ;; read the record given a testname (define (db:testmeta-get-record dbstruct testname) (let ((res #f)) (db:with-db dbstruct #f |
︙ | ︙ |
Modified megatest.scm from [da4e664704] to [e236b0be17].
︙ | ︙ | |||
1849 1850 1851 1852 1853 1854 1855 | (if (args:get-arg "-update-meta") (begin (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") (exit 1))) | < < | | 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 | (if (args:get-arg "-update-meta") (begin (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") (exit 1))) (runs:update-all-test_meta #f) (set! *didsomething* #t))) ;;====================================================================== ;; Start a repl ;;====================================================================== ;; fakeout readline |
︙ | ︙ |
Modified rmt.scm from [209649af60] to [f13d98b31b].
︙ | ︙ | |||
333 334 335 336 337 338 339 340 341 342 343 344 345 346 | (define (rmt:sdb-qry qry val run-id) ;; add caching if qry is 'getid or 'getstr (rmt:send-receive 'sdb-qry run-id (list qry val))) ;; NOT COMPLETED (define (rmt:runtests user run-id testpatt params) (rmt:send-receive 'runtests run-id testpatt)) ;;====================================================================== ;; K E Y S ;;====================================================================== ;; These require run-id because the values come from the run! ;; | > > > > > > > | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 | (define (rmt:sdb-qry qry val run-id) ;; add caching if qry is 'getid or 'getstr (rmt:send-receive 'sdb-qry run-id (list qry val))) ;; NOT COMPLETED (define (rmt:runtests user run-id testpatt params) (rmt:send-receive 'runtests run-id testpatt)) ;;====================================================================== ;; T E S T M E T A ;;====================================================================== (define (rmt:get-tests-tags) (rmt:send-receive 'get-tests-tags #f '())) ;;====================================================================== ;; K E Y S ;;====================================================================== ;; These require run-id because the values come from the run! ;; |
︙ | ︙ |
Modified runs.scm from [ebf1e29df4] to [b5157dd5f4].
︙ | ︙ | |||
1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 | (val (config-lookup test-conf "test_meta" fld))) ;; (debug:print 5 *default-log-port* "idx: " idx " fld: " fld " val: " val) (if (and val (not (equal? (vector-ref currrecord idx) val))) (begin (print "Updating " test-name " " fld " to " val) (rmt:testmeta-update-field test-name fld val))))) '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)("jobgroup" 10))))) ;; Update test_meta for all tests (define (runs:update-all-test_meta db) (let ((test-names (tests:get-all))) ;; (tests:get-valid-tests))) (for-each (lambda (test-name) (let* ((test-conf (mt:lazy-read-test-config test-name))) | > > > > > > > > > > > > > | 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 | (val (config-lookup test-conf "test_meta" fld))) ;; (debug:print 5 *default-log-port* "idx: " idx " fld: " fld " val: " val) (if (and val (not (equal? (vector-ref currrecord idx) val))) (begin (print "Updating " test-name " " fld " to " val) (rmt:testmeta-update-field test-name fld val))))) '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)("jobgroup" 10))))) ;; find tests with matching tags, tagpatt is a string "tagpatt1,tagpatt2%, ..." ;; (define (runs:get-tests-matching-tags tagpatt) (let* ((tagdata (rmt:get-tests-tags)) (res '())) ;; list of tests that match one or more tags (for-each (lambda (tag) (if (patt-list-match tag tagpatt) (set! res (append (hash-table-ref tagdata tag))))) (hash-table-keys tagdata)) res)) ;; Update test_meta for all tests (define (runs:update-all-test_meta db) (let ((test-names (tests:get-all))) ;; (tests:get-valid-tests))) (for-each (lambda (test-name) (let* ((test-conf (mt:lazy-read-test-config test-name))) |
︙ | ︙ |