Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -89,12 +89,19 @@ ;; Moving db:set-sync to a call in run.scm - it is a persistent value and only needs to be set once ;; (db:set-sync db) db)) (define (open-in-mem-db) - (let ((db (sqlite3:open-database ":memory:"))) - (db:initialize db) + (let* ((path (configf:lookup *configdat* "setup" "tmpdb")) + (fname (if path (conc path "/temp-megatest.db"))) + (exists (and path (file-exists? fname))) + (db (if path + (begin + (create-directory path #t) + (sqlite3:open-database fname)) + (sqlite3:open-database ":memory:")))) + (if (not exists) (db:initialize db)) db)) (define (db:sync-to fromdb todb) ;; strategy ;; 1. Get all run-ids @@ -112,20 +119,23 @@ ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id) (for-each (lambda (tdat) ;; iterate over tests (let ((test-id (vector-ref tdat 0))) (sqlite3:with-transaction - todb - (lambda () + todb + (lambda () (let ((curr-tdat #f)) (sqlite3:for-each-row (lambda (a . b) (set! curr-tdat (apply vector a b))) tgetstmt test-id) (if (not (equal? curr-tdat tdat)) ;; something changed (begin + (debug:print 0 " test-id: " test-id + "\ncurr-tdat: " curr-tdat + "\n tdat: " tdat) (apply sqlite3:execute tputstmt (vector->list tdat)) (set! trecchgd (+ trecchgd 1))))))))) tdats))) run-ids) (sqlite3:finalize! tgetstmt) @@ -160,16 +170,24 @@ (set! curr-rdat (apply vector a b))) rgetstmt run-id) (if (not (equal? curr-rdat rdat)) (begin + (debug:print 0 " run-id: " run-id + "\ncurr-rdat: " curr-rdat + "\n rdat: " rdat) (set! rrecchgd (+ rrecchgd 1)) (apply sqlite3:execute rputstmt (vector->list rdat)))))) rdats))) (sqlite3:finalize! rgetstmt) (sqlite3:finalize! rputstmt) - (if (> rrecchgd 0)(debug:print 0 "sync'd " rrecchgd " changed records in runs table"))))) + (if (> rrecchgd 0)(debug:print 0 "synced " rrecchgd " changed records in runs table")) + (if (> trecchgd 0)(debug:print 0 "synced " trecchgd " changed records in tests table")) + ))) + +(define (db:sync-back) + (db:sync-to *inmemdb* *db*)) ;; keeping it around for debugging purposes only (define (open-run-close-no-exception-handling proc idb . params) (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params) (if (or *db-write-access* @@ -247,43 +265,43 @@ (sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT")) keys) (sqlite3:execute db (conc "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, " fieldstr (if havekeys "," "") - "runname TEXT," - "state TEXT DEFAULT ''," - "status TEXT DEFAULT ''," - "owner TEXT DEFAULT ''," - "event_time TIMESTAMP," - "comment TEXT DEFAULT ''," + "runname TEXT DEFAULT 'norun'," + "state TEXT DEFAULT ''," + "status TEXT DEFAULT ''," + "owner TEXT DEFAULT ''," + "event_time TIMESTAMP DEFAULT (strftime('%s','now'))," + "comment TEXT DEFAULT ''," "fail_count INTEGER DEFAULT 0," "pass_count INTEGER DEFAULT 0," "CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));")) (sqlite3:execute db (conc "CREATE INDEX runs_index ON runs (runname" (if havekeys "," "") keystr ");")) (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests (id INTEGER PRIMARY KEY, - run_id INTEGER, - testname TEXT, - host TEXT DEFAULT 'n/a', - cpuload REAL DEFAULT -1, - diskfree INTEGER DEFAULT -1, - uname TEXT DEFAULT 'n/a', - rundir TEXT DEFAULT 'n/a', - shortdir TEXT DEFAULT '', - item_path TEXT DEFAULT '', - state TEXT DEFAULT 'NOT_STARTED', - status TEXT DEFAULT 'FAIL', - attemptnum INTEGER DEFAULT 0, - final_logf TEXT DEFAULT 'logs/final.log', - logdat BLOB, - run_duration INTEGER DEFAULT 0, - comment TEXT DEFAULT '', - event_time TIMESTAMP, - fail_count INTEGER DEFAULT 0, - pass_count INTEGER DEFAULT 0, - archived INTEGER DEFAULT 0, -- 0=no, 1=in progress, 2=yes + run_id INTEGER DEFAULT -1, + testname TEXT DEFAULT 'noname', + host TEXT DEFAULT 'n/a', + cpuload REAL DEFAULT -1, + diskfree INTEGER DEFAULT -1, + uname TEXT DEFAULT 'n/a', + rundir TEXT DEFAULT 'n/a', + shortdir TEXT DEFAULT '', + item_path TEXT DEFAULT '', + state TEXT DEFAULT 'NOT_STARTED', + status TEXT DEFAULT 'FAIL', + attemptnum INTEGER DEFAULT 0, + final_logf TEXT DEFAULT 'logs/final.log', + logdat TEXT DEFAULT '', + run_duration INTEGER DEFAULT 0, + comment TEXT DEFAULT '', + event_time TIMESTAMP DEFAULT (strftime('%s','now')), + fail_count INTEGER DEFAULT 0, + pass_count INTEGER DEFAULT 0, + archived INTEGER DEFAULT 0, -- 0=no, 1=in progress, 2=yes CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path) );") (sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname, item_path);") (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps Index: tests/simplerun/megatest.config ================================================================== --- tests/simplerun/megatest.config +++ tests/simplerun/megatest.config @@ -3,10 +3,11 @@ RELEASE TEXT [setup] # Adjust max_concurrent_jobs to limit how much you load your machines max_concurrent_jobs 50 +tmpdb /tmp # This is your link path, you can move it but it is generally better to keep it stable linktree #{shell readlink -f #{getenv PWD}/../simplelinks} # Valid values for state and status for steps, NB// It is not recommended you use this Index: tests/unittests/server.scm ================================================================== --- tests/unittests/server.scm +++ tests/unittests/server.scm @@ -6,10 +6,12 @@ ;; ;; (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) (set! *transport-type* 'http) +(test "open inmem db" 1 (begin (open-in-mem-db) 1)) + (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 100 'live 'http) @@ -26,11 +28,11 @@ ;; (test "launch server" #t (let ((pid (process-fork (lambda () ;; ;; (daemon:ize) ;; (server:launch 'http))))) ;; (set! server-pid pid) ;; (number? pid))) -(system "megatest -server - &") +(system "megatest -server - -debug 22&") (thread-sleep! 3) ;; need to wait for server to start. Yes, a better way is needed. (test "get-best-server" #t (begin (client:launch) (let ((dat (open-run-close tasks:get-best-server tasks:open-db))) @@ -48,12 +50,16 @@ (test "get tests (no data)" '() (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)) (test "register test" #t (rmt:general-call 'register-test 1 "test1" "")) (test "get tests (some data)" 1 (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))) (test "get test id" 1 (rmt:get-test-id 1 "test1" "")) +(test "get test id from main" 1 (db:get-test-id *db* 1 "test1" "")) + + +;; (test "sync back" #t (begin (rmt:sync-back) #t)) ;;====================================================================== ;; D B ;;====================================================================== (test #f '(#t "exit process started") (cdb:kill-server *runremote* #f)) ;; *toppath* *my-client-signature* #f)))