Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -1,11 +1,11 @@ FILES=$(glob *.scm) megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process.scm runs.scm gui.scm csc megatest.scm -dashboard: megatest dashboard.scm dashboard-tests.scm +dashboard: dashboard.scm dashboard-tests.scm csc dashboard.scm $(PREFIX)/bin/megatest : megatest @echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change sleep 5 Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -87,18 +87,18 @@ ;; trim lead from the incoming whsp to support some indenting. (if lead (string-substitute (regexp lead) "" whsp) "") val))) - (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag) + ;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag) (hash-table-set! res curr-section-name (config:assoc-safe-add alist var-flag newval)) (loop (read-line inp) curr-section-name var-flag (if lead lead whsp))) (loop (read-line inp) curr-section-name #f #f)))) (else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"") (set! var-flag #f) - (loop (read-line inp) curr-section-name)))))))) + (loop (read-line inp) curr-section-name #f #f)))))))) (define (find-and-read-config fname) (let* ((curr-dir (current-directory)) (configinfo (find-config fname)) (toppath (car configinfo)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -80,22 +80,11 @@ (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);") - (sqlite3:execute db "CREATE TABLE test_meta (id INTEGER PRIMARY KEY, - testname TEXT DEFAULT '', - author TEXT DEFAULT '', - owner TEXT DEFAULT '', - description TEXT DEFAULT '', - reviewed TIMESTAMP, - iterated TEXT DEFAULT '', - avg_runtime REAL, - avg_disk REAL, - CONSTRAINT test_meta_contstraint UNIQUE (id,testname));") - - )) + (patch-db db))) db)) ;;====================================================================== ;; TODO: ;; put deltas into an assoc list with version numbers @@ -107,24 +96,36 @@ (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));") - (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';") (db:set-var db "MEGATEST_VERSION" 1.17) ) (let ((mver (db:get-var db "MEGATEST_VERSION"))) + (print "Current schema version: " mver " current megatest version: " megatest-version) (if (not mver) (begin (print "Adding megatest-version to metadata") (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version)))) - (if (< mver 1.18) - (begin - (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) - ))) + ;; (if (< mver 1.18) + ;; (begin + ;; (print "Adding tags column to tests table") + ;; (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';"))) + (if (< mver 1.20) + (sqlite3:execute db "CREATE TABLE test_meta (id INTEGER PRIMARY KEY, + testname TEXT DEFAULT '', + author TEXT DEFAULT '', + owner TEXT DEFAULT '', + description TEXT DEFAULT '', + reviewed TIMESTAMP, + iterated TEXT DEFAULT '', + avg_runtime REAL, + avg_disk REAL, + tags TEXT DEFAULT '', + CONSTRAINT test_meta_contstraint UNIQUE (id,testname));")) + (if (< mver megatest-version) + (db:set-var db "MEGATEST_VERSION" megatest-version))))) ;;====================================================================== ;; meta get and set vars ;;====================================================================== @@ -350,10 +351,54 @@ (sqlite3:execute db "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" rundir run-id testname item-path)) +;;====================================================================== +;; Tests meta data +;;====================================================================== + +;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk +(define (make-db:testmeta)(make-vector 10)) +(define-inline (db:testmeta-get-id vec) (vector-ref vec 0)) +(define-inline (db:testmeta-get-testname vec) (vector-ref vec 1)) +(define-inline (db:testmeta-get-author vec) (vector-ref vec 2)) +(define-inline (db:testmeta-get-owner vec) (vector-ref vec 3)) +(define-inline (db:testmeta-get-description vec) (vector-ref vec 4)) +(define-inline (db:testmeta-get-reviewed vec) (vector-ref vec 5)) +(define-inline (db:testmeta-get-iterated vec) (vector-ref vec 6)) +(define-inline (db:testmeta-get-avg_runtime vec) (vector-ref vec 7)) +(define-inline (db:testmeta-get-avg_disk vec) (vector-ref vec 8)) +(define-inline (db:testmeta-get-tags vec) (vector-ref vec 9)) +(define-inline (db:testmeta-set-id! vec val)(vector-set! vec 0 val)) +(define-inline (db:testmeta-set-testname! vec val)(vector-set! vec 1 val)) +(define-inline (db:testmeta-set-author! vec val)(vector-set! vec 2 val)) +(define-inline (db:testmeta-set-owner! vec val)(vector-set! vec 3 val)) +(define-inline (db:testmeta-set-description! vec val)(vector-set! vec 4 val)) +(define-inline (db:testmeta-set-reviewed! vec val)(vector-set! vec 5 val)) +(define-inline (db:testmeta-set-iterated! vec val)(vector-set! vec 6 val)) +(define-inline (db:testmeta-set-avg_runtime! vec val)(vector-set! vec 7 val)) +(define-inline (db:testmeta-set-avg_disk! vec val)(vector-set! vec 8 val)) + +;; read the record given a testname +(define (db:testmeta-get-record db testname) + (let ((res #f)) + (sqlite3:for-each-row + (lambda (id testname author owner description reviewed iterated avg_runtime avg_disk tags) + (set! res (vector id testname author owner description reviewed iterated avg_runtime avg_disk tags))) + db "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags FROM test_meta WHERE testname=?;" + testname) + res)) + +;; create a new record for a given testname +(define (db:testmeta-add-record db testname) + (sqlite3:execute db "INSERT OR IGNORE INTO test_meta (testname) VALUES (?);" testname)) + +;; update one of the testmeta fields +(define (db:testmeta-update-field db testname field value) + (sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname)) + ;;====================================================================== ;; Steps ;;====================================================================== ;; Run steps ;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,1 +1,3 @@ -(define megatest-version 1.19) +;; Always use two digit decimal +;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. +(define megatest-version 1.20) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -426,15 +426,27 @@ (begin (print "items: ")(pp (item-assoc->item-list items)) (print "itestable: ")(pp (item-table->item-list itemstable)))) (if (args:get-arg "-m") (db:set-comment-for-run db run-id (args:get-arg "-m"))) + ;; Here is where the test_meta table is best updated - (for-each - (lambda (key) - (let ((val (config-lookup *configdat* "test_meta" key))) - + (let ((currrecord (db:testmeta-get-record db test-name))) + (if (not currrecord) + (begin + (set! currrecord (make-vector 10 #f)) + (db:testmeta-add-record db test-name))) + (for-each + (lambda (key) + (let* ((idx (cadr key)) + (fld (car key)) + (val (config-lookup test-conf "test_meta" fld))) + (if (and val (not (equal? (vector-ref currrecord idx) val))) + (begin + (print "Updating " test-name " " fld " to " val) + (db:testmeta-update-field db test-name fld val))))) + '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)))) ;; braindead work-around for poorly specified allitems list BUG!!! FIXME (if (null? allitems)(set! allitems '(()))) (let loop ((itemdat (car allitems)) (tal (cdr allitems)))