Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -157,29 +157,32 @@ (db:set-var db "MEGATEST_VERSION" megatest-version) )) ;; Create the sqlite db for the individual test(s) (define (open-test-db testpath) - (let* ((dbpath (conc testpath "/testdat.db")) - (dbexists (file-exists? dbpath)) - (db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath)) - (handler (make-busy-timeout (if (args:get-arg "-override-timeout") - (string->number (args:get-arg "-override-timeout")) - 36000)))) - (debug:print 4 "INFO: test dbpath=" dbpath) - (sqlite3:set-busy-handler! db handler) - (if (not dbexists) - (begin - (sqlite3:execute db "PRAGMA synchronous = FULL;") - (debug:print 0 "Initialized test database " dbpath) - (db:testdb-initialize db))) - (sqlite3:execute db "PRAGMA synchronous = 0;") - db)) + (if (and (directory? testpath) + (file-read-access? testpath)) + (let* ((dbpath (conc testpath "/testdat.db")) + (dbexists (file-exists? dbpath)) + (db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath)) + (handler (make-busy-timeout (if (args:get-arg "-override-timeout") + (string->number (args:get-arg "-override-timeout")) + 36000)))) + (debug:print 4 "INFO: test dbpath=" dbpath) + (sqlite3:set-busy-handler! db handler) + (if (not dbexists) + (begin + (sqlite3:execute db "PRAGMA synchronous = FULL;") + (debug:print 0 "Initialized test database " dbpath) + (db:testdb-initialize db))) + (sqlite3:execute db "PRAGMA synchronous = 0;") + db) + #f)) ;; find and open the testdat.db file for an existing test (define (db:open-test-db-by-test-id db test-id) - (let* ((test-path (db:test-get-rundir db test-id))) + (let* ((test-path (db:test-get-rundir-from-test-id db test-id))) (open-test-db test-path))) (define (db:testdb-initialize db) (for-each (lambda (sqlcmd) @@ -564,13 +567,16 @@ ;; this one is a bit broken BUG FIXME (define (db:delete-test-step-records db test-id) ;; Breaking it into two queries for better file access interleaving (let* ((tdb (db:open-test-db-by-test-id db test-id))) - (sqlite3:execute tdb "DELETE FROM test_steps;") - (sqlite3:execute tdb "DELETE FROM test_data;") - (sqlite3:finalize! tdb))) + ;; test db's can go away - must check every time + (if 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 test-id) (sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id) (sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" test-id) @@ -673,11 +679,11 @@ db "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" rundir run-id test-name item-path)) ;; -(define (db:test-get-rundir db test-id) +(define (db:test-get-rundir-from-test-id db test-id) (let ((res (hash-table-ref/default *test-paths* test-id #f))) (if res res (begin (sqlite3:for-each-row @@ -1023,18 +1029,21 @@ ;; db-get-test-steps-for-run (define (db:get-steps-for-test db test-id) (let* ((tdb (db:open-test-db-by-test-id db test-id)) (res '())) - (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))) - tdb - "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; - test-id) - (sqlite3:finalize! tdb) - (reverse res))) + (if tdb + (begin + (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))) + tdb + "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + test-id) + (sqlite3:finalize! tdb) + (reverse res)) + '()))) ;; get a pretty table to summarize steps ;; (define (db:get-steps-table db test-id) (let ((steps (db:get-steps-for-test db test-id))) @@ -1152,15 +1161,18 @@ (state (check-valid-items "state" state-in)) (status (check-valid-items "status" status-in))) (if (or (not state)(not status)) (debug:print 0 "WARNING: Invalid " (if status "status" "state") " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config")) - (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 ""))) - #t) + (if 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 "")) + #t) + #f))) ;;====================================================================== ;; Extract ods file from the db ;;====================================================================== Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -104,24 +104,21 @@ (server:client-setup db)) ;; (set! *cache-on* #t) (set-megatest-env-vars db run-id) ;; these may be needed by the launching process (change-directory work-area) - ;; Open up the test specific database - (set! tdb (open-test-db work-area)) (on-exit (lambda () - (debug:print 0 "Finalizing both tdb and db!!!") - (sqlite3:finalize! tdb) + (debug:print 0 "Finalizing db!!!") (sqlite3:finalize! db))) (set-run-config-vars db run-id) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) (set-megatest-env-vars db run-id) (set-item-env-vars itemdat) (save-environment-as-files "megatest") - (test-set-meta-info db tdb run-id test-name itemdat) + (test-set-meta-info db test-id run-id test-name itemdat) (test-set-status! db test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f) (if (args:get-arg "-xterm") (set! fullrunscript "xterm") (if (and fullrunscript (not (file-execute-access? fullrunscript))) (system (conc "chmod ug+x " fullrunscript)))) @@ -270,11 +267,11 @@ ;; (if (not (args:get-arg "-server")) ;; (server:client-setup db)) ;; (if (not cpuload) (begin (debug:print 0 "WARNING: CPULOAD not found.") (set! cpuload "n/a"))) ;; (if (not diskfree) (begin (debug:print 0 "WARNING: DISKFREE not found.") (set! diskfree "n/a"))) (set! kill-job? (test-get-kill-request db run-id test-name itemdat)) - (test-set-meta-info db tdb run-id test-name itemdat minutes: minutes) + (test-set-meta-info db test-id run-id test-name itemdat minutes: minutes) ;; (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree) (if kill-job? (begin (mutex-lock! m) (let* ((pid (vector-ref exit-info 0))) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -402,20 +402,23 @@ (let* ((item-path (item-list->path itemdat)) (testdat (db:get-test-info db run-id test-name item-path))) (equal? (test:get-state testdat) "KILLREQ"))) (define (test:tdb-get-rundat-count tdb) - (let ((res 0)) - (sqlite3:for-each-row - (lambda (count) - (set! res count)) - tdb - "SELECT count(id) FROM test_rundat;") - res)) - -(define (test-set-meta-info db tdb run-id testname itemdat #!key (minutes #f)) - (let* ((num-records (test:tdb-get-rundat-count tdb)) + (if tdb + (let ((res 0)) + (sqlite3:for-each-row + (lambda (count) + (set! res count)) + tdb + "SELECT count(id) FROM test_rundat;") + res)) + 0) + +(define (test-set-meta-info db test-id run-id testname itemdat #!key (minutes #f)) + (let* ((tdb (db:open-test-db-by-test-id db test-id)) + (num-records (test:tdb-get-rundat-count tdb)) (item-path (item-list->path itemdat)) (cpuload (get-cpu-load)) (diskfree (get-df (current-directory)))) (if (eq? (modulo num-records 10) 0) ;; every ten records update central (begin