Overview
Comment: | Adding additional safety net for testdat.db access |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.55 |
Files: | files | file ages | folders |
SHA1: |
0e0610387ad4ceafd1dec78e7d45e9c5 |
User & Date: | matt on 2013-11-02 18:37:48 |
Other Links: | branch diff | manifest | tags |
Context
2013-11-02
| ||
19:15 | Fixed crash in server mode due to wrongly remoting the update test meta call check-in: 37d6497d18 user: matt tags: v1.55 | |
18:37 | Adding additional safety net for testdat.db access check-in: 0e0610387a user: matt tags: v1.55 | |
11:50 | Minimised data transferred on dashboard updates check-in: 0f8bb62316 user: matt tags: v1.55 | |
Changes
Modified db.scm from [f462a4658f] to [e71a03e8ca].
︙ | ︙ | |||
483 484 485 486 487 488 489 490 491 492 493 494 495 496 | (run-ids (db:get-run-ids db))) ;; iterate over runs to divy up the calls (if (number? ovr-deadtime)(set! deadtime ovr-deadtime)) (for-each (lambda (run-id) ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes ;; (sqlite3:for-each-row (lambda (test-id) (set! incompleted (cons test-id incompleted))) db "SELECT id FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time - run_duration) > ? AND state IN ('RUNNING','REMOTEHOSTSTART');" run-id deadtime) | > > > | 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 | (run-ids (db:get-run-ids db))) ;; iterate over runs to divy up the calls (if (number? ovr-deadtime)(set! deadtime ovr-deadtime)) (for-each (lambda (run-id) ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes ;; ;; THIS CANNOT WORK. The run_duration is not updated in the central db due to performance concerns. ;; The testdat.db file must be consulted. ;; (sqlite3:for-each-row (lambda (test-id) (set! incompleted (cons test-id incompleted))) db "SELECT id FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time - run_duration) > ? AND state IN ('RUNNING','REMOTEHOSTSTART');" run-id deadtime) |
︙ | ︙ | |||
1127 1128 1129 1130 1131 1132 1133 | res)) ;; this one is a bit broken BUG FIXME (define (db:delete-test-step-records db test-id #!key (work-area #f)) ;; Breaking it into two queries for better file access interleaving (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) ;; test db's can go away - must check every time | | | 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 | res)) ;; this one is a bit broken BUG FIXME (define (db:delete-test-step-records db test-id #!key (work-area #f)) ;; Breaking it into two queries for better file access interleaving (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) ;; test db's can go away - must check every time (if (sqlite3:database? tdb) (begin (sqlite3:execute tdb "DELETE FROM test_steps;") (sqlite3:execute tdb "DELETE FROM test_data;") (sqlite3:finalize! tdb))))) ;; (define (db:delete-test-records db tdb test-id #!key (force #f)) |
︙ | ︙ | |||
2000 2001 2002 2003 2004 2005 2006 | ;;====================================================================== ;; T E S T D A T A ;;====================================================================== (define (db:csv->test-data db test-id csvdata #!key (work-area #f)) (debug:print 4 "test-id " test-id ", csvdata: " csvdata) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) | | | 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 | ;;====================================================================== ;; T E S T D A T A ;;====================================================================== (define (db:csv->test-data db test-id csvdata #!key (work-area #f)) (debug:print 4 "test-id " test-id ", csvdata: " csvdata) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) (if (sqlite3:database? tdb) (let ((csvlist (csv->list (make-csv-reader (open-input-string csvdata) '((strip-leading-whitespace? #t) (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata))) (for-each (lambda (csvrow) (let* ((padded-row (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9)) |
︙ | ︙ | |||
2060 2061 2062 2063 2064 2065 2066 | test-id category variable value expected tol units (if comment comment "") status type))) csvlist) (sqlite3:finalize! tdb))))) ;; get a list of test_data records matching categorypatt (define (db:read-test-data db test-id categorypatt #!key (work-area #f)) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) | | | 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 | test-id category variable value expected tol units (if comment comment "") status type))) csvlist) (sqlite3:finalize! tdb))))) ;; get a list of test_data records matching categorypatt (define (db:read-test-data db test-id categorypatt #!key (work-area #f)) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) (if (sqlite3:database? tdb) (let ((res '())) (sqlite3:for-each-row (lambda (id test_id category variable value expected tol units comment status type) (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) tdb "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) (sqlite3:finalize! tdb) |
︙ | ︙ | |||
2092 2093 2094 2095 2096 2097 2098 | ;; look at the test_data status field, ;; if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS. ;; if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored (define (db:test-data-rollup db test-id status #!key (work-area #f)) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)) (fail-count 0) (pass-count 0)) | | | 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 | ;; look at the test_data status field, ;; if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS. ;; if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored (define (db:test-data-rollup db test-id status #!key (work-area #f)) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)) (fail-count 0) (pass-count 0)) (if (sqlite3:database? tdb) (begin (sqlite3:for-each-row (lambda (fcount pcount) (set! fail-count fcount) (set! pass-count pcount)) tdb "SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count, |
︙ | ︙ | |||
2145 2146 2147 2148 2149 2150 2151 | (define (db:step-get-time-as-string vec) (seconds->time-string (db:step-get-event_time vec))) ;; db-get-test-steps-for-run (define (db:get-steps-for-test db test-id #!key (work-area #f)) (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)) (res '())) | | | 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 | (define (db:step-get-time-as-string vec) (seconds->time-string (db:step-get-event_time vec))) ;; db-get-test-steps-for-run (define (db:get-steps-for-test db test-id #!key (work-area #f)) (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)) (res '())) (if (sqlite3:database? tdb) (handle-exceptions exn (debug:print 0 "ERROR: error on access to testdat for test with id " test-id) '() (sqlite3:for-each-row (lambda (id test-id stepname state status event-time logfile) (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res))) |
︙ | ︙ | |||
2387 2388 2389 2390 2391 2392 2393 | ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) (if (not ever-seen) (set! result (append (if (null? tests)(list waitontest-name) tests) result))))) waitons) (delete-duplicates result)))) (define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile #!key (work-area #f)) | < | | 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 | ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) (if (not ever-seen) (set! result (append (if (null? tests)(list waitontest-name) tests) result))))) waitons) (delete-duplicates result)))) (define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile #!key (work-area #f)) ;; db:open-test-db-by-test-id does cdb:remote-run (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)) (state (items:check-valid-items "state" state-in)) (status (items:check-valid-items "status" status-in))) (if (or (not state)(not status)) (debug:print 3 "WARNING: Invalid " (if status "status" "state") " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config")) (if (sqlite3:database? tdb) (begin (sqlite3:execute tdb "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);" test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile "")) (sqlite3:finalize! tdb) #t) |
︙ | ︙ |
Modified runs.scm from [4d2175af10] to [5418f204f0].
︙ | ︙ | |||
206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 | (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config")) (required-tests '()) (test-records (make-hash-table)) (all-tests-registry (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names (all-test-names (hash-table-keys all-tests-registry)) (test-names (tests:filter-test-names all-test-names test-patts))) ;; Update the synchronous setting in the db based on the default or what is set by the user (cdb:remote-run db:set-sync #f) (set-megatest-env-vars run-id inkeys: keys) ;; these may be needed by the launching process (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals "pre-launch-env-vars") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) | > > | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config")) (required-tests '()) (test-records (make-hash-table)) (all-tests-registry (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names (all-test-names (hash-table-keys all-tests-registry)) (test-names (tests:filter-test-names all-test-names test-patts))) ;; Update the synchronous setting in the db based on the default or what is set by the user ;; This is done once here on a call to run tests rather than on every call to open-db (cdb:remote-run db:set-sync #f) (set-megatest-env-vars run-id inkeys: keys) ;; these may be needed by the launching process (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals "pre-launch-env-vars") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) |
︙ | ︙ |
Modified tests.scm from [8d71943f1e] to [72fd2eb38f].
︙ | ︙ | |||
724 725 726 727 728 729 730 | ;; Update central with uname and hostname = #f ;; Is this one of the performance problems? This info should come from testdat-meta anyway ;; (tests:update-central-meta-info test-id cpuload diskfree minutes #f #f) )) (define (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) | | | | 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 | ;; Update central with uname and hostname = #f ;; Is this one of the performance problems? This info should come from testdat-meta anyway ;; (tests:update-central-meta-info test-id cpuload diskfree minutes #f #f) )) (define (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) (if (sqlite3:database? tdb) (begin (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);" cpuload diskfree minutes) (sqlite3:finalize! tdb)) (debug:print 2 "Can't update testdat.db for test " test-id " read-only or non-existant")))) (define (tests:testdat-get-testinfo db test-id work-area) (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)) (res '())) (if (sqlite3:database? tdb) (sqlite3:for-each-row (lambda (update-time cpuload diskfree run-duration) (set! res (cons (vector update-time cpuload diskfree run-duration) res))) tdb "SELECT update_time,cpuload,diskfree,run_duration FROM test_rundat ORDER BY update_time ASC;") (sqlite3:finalize! tdb)) res)) |
︙ | ︙ |
Modified tests/fdktestqa/testqa/megatest.config from [cfe5ca96f4] to [c62ce89d66].
1 2 3 | [setup] testcopycmd cp --remove-destination -rlv TEST_SRC_PATH/. TEST_TARG_PATH/. >> TEST_TARG_PATH/mt_launch.log 2>> TEST_TARG_PATH/mt_launch.log runqueue 20 | | | 1 2 3 4 5 6 7 8 9 10 | [setup] testcopycmd cp --remove-destination -rlv TEST_SRC_PATH/. TEST_TARG_PATH/. >> TEST_TARG_PATH/mt_launch.log 2>> TEST_TARG_PATH/mt_launch.log runqueue 20 # transport http launchwait no [include ../fdk.config] [server] port 9080 |
Modified tests/fullrun/megatest.config from [fe7d45ffb7] to [9ccb67a28b].
︙ | ︙ | |||
19 20 21 22 23 24 25 | [setup] # Set launchwait to no to use the more agressive code that does not wait for the launch to complete before proceeding # this may save a few milliseconds on launching tests # launchwait no # Use http instead of direct filesystem access | | | | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | [setup] # Set launchwait to no to use the more agressive code that does not wait for the launch to complete before proceeding # this may save a few milliseconds on launching tests # launchwait no # Use http instead of direct filesystem access transport http # transport fs # If set to "default" the old code is used. Otherwise defaults to 200 or uses # numeric value given. # runqueue 20 # Default runtimelim 1d 1h 1m 10s |
︙ | ︙ |