Overview
Comment: | Fixing tests |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | interleaved-queries |
Files: | files | file ages | folders |
SHA1: |
856aa4b5ec44b5ee69bb3917984d2551 |
User & Date: | matt on 2012-11-20 01:11:52 |
Other Links: | branch diff | manifest | tags |
Context
2012-11-20
| ||
07:32 | (no comment) check-in: 6c9186d4af user: matt tags: interleaved-queries | |
01:11 | Fixing tests check-in: 856aa4b5ec user: matt tags: interleaved-queries | |
2012-11-19
| ||
19:43 | Added back a missing "not" check-in: b21db309a8 user: matt tags: interleaved-queries | |
Changes
Modified db.scm from [cafb82815a] to [cead3c7ecc].
︙ | ︙ | |||
1231 1232 1233 1234 1235 1236 1237 | '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") )) ;; do not run these as part of the transaction (define db:special-queries '(rollup-tests-pass-fail db:roll-up-pass-fail-counts login | | > | 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 | '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") )) ;; do not run these as part of the transaction (define db:special-queries '(rollup-tests-pass-fail db:roll-up-pass-fail-counts login immediate flush)) ;; not used, intended to indicate to run in calling process (define db:run-local-queries '()) ;; rollup-tests-pass-fail)) ;; The queue is a list of vectors where the zeroth slot indicates the type of query to ;; apply and the second slot is the time of the query and the third entry is a list of ;; values to be applied |
︙ | ︙ | |||
1260 1261 1262 1263 1264 1265 1266 | (if (not (hash-table-ref/default queries stmt-key #f)) (let ((stmt (alist-ref stmt-key db:queries))) (debug:print-info 11 "stmt-key=" stmt-key ", stmt=" stmt) (if stmt (hash-table-set! queries stmt-key (sqlite3:prepare db (car stmt))) (if (procedure? stmt-key) (hash-table-set! queries stmt-key #f) | > | | 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 | (if (not (hash-table-ref/default queries stmt-key #f)) (let ((stmt (alist-ref stmt-key db:queries))) (debug:print-info 11 "stmt-key=" stmt-key ", stmt=" stmt) (if stmt (hash-table-set! queries stmt-key (sqlite3:prepare db (car stmt))) (if (procedure? stmt-key) (hash-table-set! queries stmt-key #f) (if (not (member stmt-key db:special-queries)) (debug:print 0 "ERROR: Missing query spec for " stmt-key "!")))))))) data) ;; outer loop to handle special queries that cannot be handled in the ;; transaction. (let outerloop ((special-qry #f) (stmts data)) (debug:print-info 11 "special-qry=" special-qry ", stmts=" stmts) |
︙ | ︙ | |||
1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 | (client-key (caddr params))) (if (and (equal? calling-path *toppath*) (equal? megatest-version calling-vers)) (begin (hash-table-set! *logged-in-clients* client-key (current-seconds)) (server:reply pubsock return-address '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ... (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*)))))) (else (debug:print 0 "ERROR: Unrecognised queued call " qry " " params))))) (if (not (null? stmts)) (outerloop #f stmts))) ;; handle normal queries (let ((rem (sqlite3:with-transaction | > > | 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 | (client-key (caddr params))) (if (and (equal? calling-path *toppath*) (equal? megatest-version calling-vers)) (begin (hash-table-set! *logged-in-clients* client-key (current-seconds)) (server:reply pubsock return-address '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ... (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*)))))) ((flush) (server:reply pubsock return-address '(#t "sucessful flush"))) (else (debug:print 0 "ERROR: Unrecognised queued call " qry " " params))))) (if (not (null? stmts)) (outerloop #f stmts))) ;; handle normal queries (let ((rem (sqlite3:with-transaction |
︙ | ︙ |
Modified tests/tests.scm from [1b09dbc8f0] to [77a9ed7a49].
︙ | ︙ | |||
76 77 78 79 80 81 82 | ;;====================================================================== ;; S E R V E R ;;====================================================================== (test "setup for run" #t (begin (setup-for-run) (string? (getenv "MT_RUN_AREA_HOME")))) | | | | | > | | | | | | > > > | | < < | 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 108 109 110 111 112 113 114 115 116 117 118 119 120 | ;;====================================================================== ;; S E R V E R ;;====================================================================== (test "setup for run" #t (begin (setup-for-run) (string? (getenv "MT_RUN_AREA_HOME")))) (test "server-register, get-best-server" #t (let ((res #f)) (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 1235 100 'live) (set! res (open-run-close tasks:get-best-server tasks:open-db)) (number? (cadddr res)))) (test "de-register server" #t (let ((res #f)) (open-run-close tasks:server-deregister tasks:open-db "bob" pullport: 1234) (list? (open-run-close tasks:get-best-server tasks:open-db)))) (define hostinfo #f) (test "get-best-server" #t (let ((dat (open-run-close tasks:get-best-server tasks:open-db))) (set! hostinfo dat) ;; host ip pullport pubport (and (string? (car dat)) (number? (caddr dat))))) (test #f #t (let ((zmq-socket (server:client-connect (cadr hostinfo) (caddr hostinfo) (cadddr hostinfo)))) (set! *runremote* zmq-socket) (socket? (vector-ref *runremote* 0)))) (test #f #t (let ((res (server:client-login *runremote*))) (car res))) (test #f #t (socket? (vector-ref *runremote* 0))) ;; (test #f #t (server:client-setup)) (test #f #t (car (cdb:login *runremote* *toppath* *my-client-signature*))) ;;====================================================================== ;; 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))) (test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f))) |
︙ | ︙ |