Overview
Comment: | Added mechanism to update db schema |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
3bb0b5e9f9774139e657a36648bee781 |
User & Date: | matt on 2011-07-18 23:13:18 |
Other Links: | manifest | tags |
Context
2011-07-19
| ||
00:08 | Added support for tags to megatest. Dashboard not done yet check-in: 6654e3905e user: matt tags: trunk | |
2011-07-18
| ||
23:13 | Added mechanism to update db schema check-in: 3bb0b5e9f9 user: matt tags: trunk | |
2011-07-13
| ||
23:15 | Re-factored dashboard to elimnate using threads and to use the iup:timer instead check-in: 112fdec9c0 user: mrwellan tags: trunk | |
Changes
Modified dashboard.scm from [e9212eda7d] to [74244af35f].
︙ | ︙ | |||
26 27 28 29 30 31 32 33 34 35 36 37 38 39 | (include "db.scm") (include "configf.scm") (include "process.scm") (include "launch.scm") (include "runs.scm") (include "gui.scm") (include "dashboard-tests.scm") (define help " Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version 0.2 license GPL, Copyright Matt Welland 2011 Usage: dashboard [options] | > | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | (include "db.scm") (include "configf.scm") (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 Usage: dashboard [options] |
︙ | ︙ |
Modified db.scm from [5c1eda37b3] to [88fcf141f5].
︙ | ︙ | |||
48 49 50 51 52 53 54 | (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', | | > > > > > > > > > > > > > > | > > > > > > > > > | > | > | > > > > > | > | > > > | > > | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 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 121 122 123 124 125 126 127 128 129 130 131 132 133 | (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', 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, 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 (id INTEGER PRIMARY KEY, test_id INTEGER, stepname TEXT, 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)) (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) (set! res (cons (vector key keytype) res))) db |
︙ | ︙ |
Added megatest-version.scm version [d7a309cb03].
> | 1 | (define megatest-version 1.18) |
Modified megatest.scm from [dddaf7ea57] to [95886c7e30].
1 2 3 4 5 6 7 8 9 10 | ;; Copyright 2006-2011, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. (include "common.scm") | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | ;; Copyright 2006-2011, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. (include "common.scm") (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 Usage: megatest [options] |
︙ | ︙ | |||
50 51 52 53 54 55 56 57 58 59 60 61 62 63 | -remove-runs : remove the data for a run, requires all fields be specified and :runname ,-testpatt and -itempatt 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) 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 stepname.html and sets log to same If using make use stepname_logpro.log as your target | > | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | -remove-runs : remove the data for a run, requires all fields be specified and :runname ,-testpatt and -itempatt 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 stepname.html and sets log to same If using make use stepname_logpro.log as your target |
︙ | ︙ | |||
96 97 98 99 100 101 102 103 104 105 106 107 108 109 | "-showkeys" "-test-status" "-gui" "-runall" ;; run all tests "-remove-runs" "-keepgoing" "-usequeue" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only ) args:arg-hash 0)) (if (args:get-arg "-h") | > | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | "-showkeys" "-test-status" "-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)) (if (args:get-arg "-h") |
︙ | ︙ | |||
651 652 653 654 655 656 657 658 659 660 661 662 663 664 | (set! *didsomething* #t))) (if (args:get-arg "-gui") (begin (debug:print 0 "Look at the dashboard for now") ;; (megatest-gui) (set! *didsomething* #t))) (if (not *didsomething*) (debug:print 0 help)) (if (not (eq? *globalexitstatus* 0)) (if (or (args:get-arg "-runtests")(args:get-arg "-runall")) (begin | > > > > > > > > > > > > > > > > | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 | (set! *didsomething* #t))) (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)) (if (or (args:get-arg "-runtests")(args:get-arg "-runall")) (begin |
︙ | ︙ |
Modified tests/tests.scm from [6fc7061e87] to [51a14a8524].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | (use test) ;; (require-library args) (include "../common.scm") (include "../keys.scm") (include "../db.scm") (include "../configf.scm") (include "../process.scm") (include "../launch.scm") (include "../items.scm") (include "../runs.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"))) (set! conffile (read-config "test.config")) (test "Get available diskspace" #t (number? (get-df "./"))) | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | (use test) ;; (require-library args) (include "../common.scm") (include "../keys.scm") (include "../db.scm") (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"))) (set! conffile (read-config "test.config")) (test "Get available diskspace" #t (number? (get-df "./"))) |
︙ | ︙ | |||
28 29 30 31 32 33 34 35 36 37 38 39 40 41 | ;; (define *toppath* "tests") (define *db* #f) (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))) (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") (string-split (config-lookup *configdat* "validvalues" "state"))) | > > > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | ;; (define *toppath* "tests") (define *db* #f) (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") (string-split (config-lookup *configdat* "validvalues" "state"))) |
︙ | ︙ |