Overview
Comment: | Partial completion of compact test patt |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
306c685da39d9b00fe2d7a48e1f18680 |
User & Date: | mrwellan on 2012-10-12 16:23:31 |
Other Links: | manifest | tags |
Context
2012-10-12
| ||
17:22 | Compact test pattern specification now working for all features check-in: 1303bd53c2 user: matt tags: trunk | |
16:23 | Partial completion of compact test patt check-in: 306c685da3 user: mrwellan tags: trunk | |
14:03 | Converted runs queue to use compact test pattern spec. check-in: 56eeb9f895 user: mrwellan tags: trunk | |
Changes
Modified db.scm from [4e59e299af] to [d8d87fb6d6].
︙ | |||
619 620 621 622 623 624 625 | 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 | - + - - + - | #f)) ;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN ;; i.e. these lists define what to NOT show. ;; states and statuses are required to be lists, empty is ok ;; not-in #t = above behaviour, #f = must match |
︙ | |||
918 919 920 921 922 923 924 | 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 | - - + + - - + + | (debug:print 0 "ERROR: db:test-set-log! called with non-string log file name " logf))) ;;====================================================================== ;; Misc. test related queries ;;====================================================================== (define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '())) |
︙ |
Modified megatest.scm from [ee41476089] to [602cbb5039].
︙ | |||
249 250 251 252 253 254 255 | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 | - | (begin (debug:print 0 "ERROR: Attempted " action "on test(s) but run area config file not found") (exit 1)) ;; put test parameters into convenient variables (runs:operate-on action (args:get-arg ":runname") (args:get-arg "-testpatt") |
︙ | |||
278 279 280 281 282 283 284 | 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 | - - + | ;;====================================================================== (if (args:get-arg "-list-runs") (if (setup-for-run) (let* ((db #f) (runpatt (args:get-arg "-list-runs")) (testpatt (args:get-arg "-testpatt")) |
︙ |
Modified tests.scm from [3f984a1f12] to [e23080303a].
︙ | |||
72 73 74 75 76 77 78 79 80 81 82 83 84 85 | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | + + + + + + + + + + + + + + + + + + + + + + | (if (and (tests:glob-like-match test-patt testname) (or (not itempath) (tests:glob-like-match (if item-patt item-patt "") itempath))) #t (if (null? tal) #f (loop (car tal)(cdr tal))))))))))) ;; if itempath is #f then look only at the testname part ;; (define (tests:match->sqlqry patterns) (if (string? patterns) (let ((patts (string-split patterns ","))) (if (null? patts) ;;; no pattern(s) means no match, we will do no query "" (let loop ((patt (car patts)) (tal (cdr patts)) (res '())) ;; (print "loop: patt: " patt ", tal " tal) (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt)) (test-patt (cadr patt-parts)) (item-patt (cadddr patt-parts)) (test-qry (db:patt->like "testname" test-patt)) (item-qry (db:patt->like "item_path" item-patt)) (qry (conc "(" test-qry " AND " item-qry ")"))) ;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt) (if (null? tal) (string-intersperse (append (reverse res)(list qry)) " OR ") (loop (car tal)(cdr tal)(cons qry res))))))))) ;; get the previous record for when this test was run where all keys match but runname ;; returns #f if no such test found, returns a single test record if found (define (test:get-previous-test-run-record db run-id test-name item-path) (let* ((keys (db:get-keys db)) (selstr (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ",")) (qrystr (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND ")) |
︙ |
Modified tests/Makefile from [917ce71b5f] to [ac85d888c8].
︙ | |||
24 25 26 27 28 29 30 | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | - - + + | rm -f simplerun/megatest.db rm -rf simplelinks/ simpleruns/ mkdir -p simplelinks simpleruns cd simplerun;cp ../../*_records.scm .;perl -pi.bak -e 's/define-inline/define/' *_records.scm cd simplerun;echo '(load "../tests.scm")' | $(MEGATEST) -repl -debug $(DEBUG) test2 : fullprep |
︙ |
Modified tests/tests.scm from [537d09ec91] to [7754b17b82].
︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | + + + + + + + + + + + + + + + + | (test "cmd-run-with-stderr->list" '("No such file or directory") (let ((reslst (cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist"))) (string-search (regexp "No such file or directory")(car reslst)))) ;;====================================================================== ;; T E S T M A T C H I N G ;;====================================================================== ;; tests:glob-like-match (test #f '("abc") (tests:glob-like-match "abc" "abc")) (for-each (lambda (patt str expected) (test (conc patt " " str "=>" expected) expected (tests:glob-like-match patt str))) (list "abc" "~abc" "~abc" "a*c" "a%c") (list "abc" "abcd" "abc" "ABC" "ABC") (list '("abc") #t #f #f '("ABC")) ) ;; tests:match (test #f #t (tests:match "abc/def" "abc" "def")) (for-each (lambda (patterns testname itempath expected) (test (conc patterns " " testname "/" itempath "=>" expected) expected (tests:match patterns testname itempath))) (list "abc" "abc/%" "ab%/c%" "~abc/c%" "abc/~c%" "a,b/c,%/d") (list "abc" "abc" "abcd" "abc" "abc" "a" ) (list "" "" "cde" "cde" "cde" "" ) (list #t #t #t #f #f #t)) ;; db:patt->like (test #f "testname LIKE 't%'" (db:patt->like "testname" "t%" comparator: " AND ")) (test #f "testname LIKE 't%' AND testname LIKE '%t'" (db:patt->like "testname" "t%,%t" comparator: " AND ")) (test #f "item_path GLOB ''" (db:patt->like "item_path" "")) ;; test:match->sqlqry (test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')" (tests:match->sqlqry "a/b,a%,/b%")) (test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')" (tests:match->sqlqry "a/b,a%,%/b%")) ;; (exit) ;;====================================================================== ;; C O N F I G F I L E S ;;====================================================================== (define conffile #f) (test "Read a config" #t (hash-table? (read-config "test.config" #f #f))) |
︙ | |||
227 228 229 230 231 232 233 234 235 236 237 238 239 240 | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 | + + | (test "Create a test db" "../simpleruns/key1/key2/myrun/test1/testdat.db" (let ((tdb (db:open-test-db-by-test-id db test-id))) (sqlite3#finalize! tdb) (file-exists? "../simpleruns/key1/key2/myrun/test1/testdat.db"))) (test "Get steps for test" #t (> (length (db:get-steps-for-test db test-id)) 0)) (test "Get nice table for steps" "2.0s" (begin (vector-ref (hash-table-ref (db:get-steps-table db test-id) "step1") 4))) (exit) ;;====================================================================== ;; R E M O T E C A L L S ;;====================================================================== ;; start a server process (set! *verbosity* 10) |
︙ |