Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -28,10 +28,11 @@ (include "process.scm") (include "launch.scm") (include "runs.scm") (include "gui.scm") (include "dashboard-tests.scm") +(include "megatest-version.scm") (define help " Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version 0.2 license GPL, Copyright Matt Welland 2011 Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -50,11 +50,11 @@ 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', + rundir TEXT DEFAULT 'n/a', item_path TEXT DEFAULT '', state TEXT DEFAULT 'NOT_STARTED', status TEXT DEFAULT 'FAIL', attemptnum INTEGER DEFAULT 0, final_logf TEXT DEFAULT 'logs/final.log', @@ -62,10 +62,11 @@ run_duration INTEGER DEFAULT 0, comment TEXT DEFAULT '', event_time TIMESTAMP, fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, + tags TEXT DEFAULT '', CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path) );") (sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname);") (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 test_steps @@ -75,21 +76,56 @@ state TEXT DEFAULT 'NOT_STARTED', status TEXT DEFAULT 'n/a',event_time TIMESTAMP, comment TEXT DEFAULT '', CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));") (sqlite3:execute db "CREATE TABLE extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);") + (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT, + CONSTRAINT metadat_constraint UNIQUE (id,var));") + (db:set-var db "MEGATEST_VERSION" megatest-version) (sqlite3:execute db "CREATE TABLE access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);"))) db)) -;; (if (args:get-arg "-db") -;; (set! db (open-db (args:get-arg "-db")))) - -;; TODO -;; -;; 1. Implement basic registering of records -;; 2. Implement basic querying of records -;; eh? +(define (patch-db db) + (handle-exceptions + exn + (begin + (print "Exception: " exn) + (print "ERROR: Possible out of date schema, attempting to add table metadata...") + (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT, + CONSTRAINT metadat_constraint UNIQUE (id,var));") + (db:set-var db "MEGATEST_VERSION" megatest-version) + (print-call-chain)) + (let ((mver (db:get-var db "MEGATEST_VERSION"))) + (cond + ((not mver) + (print "Adding megatest-version to metadata") + (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version))) + ((< mver 1.18) + (print "Adding tags column to tests table") + (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';") + )) + (db:set-var db "MEGATEST_VERSION" megatest-version) + ))) + +;;====================================================================== +;; meta get and set vars +;;====================================================================== + +;; returns number if string->number is successful, string otherwise +(define (db:get-var db var) + (let ((res #f)) + (sqlite3:for-each-row + (lambda (val) + (set! res val)) + db "SELECT val FROM metadat WHERE var=?;" var) + (if (string? res) + (let ((valnum (string->number res))) + (if valnum valnum res)) + res))) + +(define (db:set-var db var val) + (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)) (define (db-get-keys db) (let ((res '())) (sqlite3:for-each-row (lambda (key keytype) ADDED megatest-version.scm Index: megatest-version.scm ================================================================== --- /dev/null +++ megatest-version.scm @@ -0,0 +1,1 @@ +(define megatest-version 1.18) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -6,11 +6,11 @@ ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. (include "common.scm") -(define megatest-version 1.17) +(include "megatest-version.scm") (define help (conc " Megatest, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version " license GPL, Copyright Matt Welland 2006-2011 @@ -52,10 +52,11 @@ and -testpatt -keepgoing : continue running until no jobs are \"LAUNCHED\" or \"NOT_STARTED\" -rerun FAIL,WARN... : re-run if called on a test that previously ran (nullified if -keepgoing is also specified) + -rebuild-db : bring the database schema up to date Helpers -runstep stepname ... : take remaining params as comand and execute as stepname log will be in stepname.log. Best to put command in quotes -logpro file : with -exec apply logpro file to stepname.log, creates @@ -98,10 +99,11 @@ "-gui" "-runall" ;; run all tests "-remove-runs" "-keepgoing" "-usequeue" + "-rebuild-db" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only ) args:arg-hash 0)) @@ -653,10 +655,26 @@ (if (args:get-arg "-gui") (begin (debug:print 0 "Look at the dashboard for now") ;; (megatest-gui) (set! *didsomething* #t))) + +;;====================================================================== +;; Update the database schema on request +;;====================================================================== + +(if (args:get-arg "-rebuild-db") + (begin + (if (not (setup-for-run)) + (begin + (debug:print 0 "Failed to setup, exiting") + (exit 1))) + ;; now can find our db + (set! db (open-db)) + (patch-db db) + (sqlite3:finalize! db) + (set! *didsomething* #t))) (if (not *didsomething*) (debug:print 0 help)) (if (not (eq? *globalexitstatus* 0)) Index: tests/tests.scm ================================================================== --- tests/tests.scm +++ tests/tests.scm @@ -7,10 +7,11 @@ (include "../configf.scm") (include "../process.scm") (include "../launch.scm") (include "../items.scm") (include "../runs.scm") +(include "../megatest-version.scm") (define conffile #f) (test "Read a config" #t (hash-table? (read-config "test.config"))) (test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config"))) @@ -30,10 +31,13 @@ (test "setup for run" #t (begin (setup-for-run) (string? (getenv "MT_RUN_AREA_HOME")))) (test "open-db" #t (begin (set! *db* (open-db)) (if *db* #t #f))) + +;; quit wasting time changing db to *db* +(define db *db*) (test "get cpu load" #t (number? (get-cpu-load))) (test "get uname" #t (string? (get-uname))) (test "get validvalues as list" (list "start" "end" "completed")