Overview
Comment: | Added support for tags to megatest. Dashboard not done yet |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
6654e3905edd7eed62adb123c8c0e622 |
User & Date: | matt on 2011-07-19 00:08:45 |
Other Links: | manifest | tags |
Context
2011-07-19
| ||
00:22 | Tweaked ordering on db updates check-in: e253e9fefb user: matt tags: trunk, v1.18 | |
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 | |
Changes
Modified db.scm from [88fcf141f5] to [b0a0444891].
︙ | ︙ | |||
80 81 82 83 84 85 86 | (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)) | | | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | (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)heh (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));") |
︙ | ︙ |
Modified launch.scm from [5bfe54be51] to [f4b3156c75].
︙ | ︙ | |||
18 19 20 21 22 23 24 | (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) (if *toppath* (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated (debug:print 0 "ERROR: failed to find the top path to your run setup.")) *toppath*) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) (if *toppath* (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated (debug:print 0 "ERROR: failed to find the top path to your run setup.")) *toppath*) (define (get-best-disk confdat) (let* ((disks (hash-table-ref/default confdat "disks" #f)) (best #f) (bestsize 0)) (if disks (for-each (lambda (disk-num) |
︙ | ︙ | |||
90 91 92 93 94 95 96 | (if (not (equal? item-path "")) (db:test-set-rundir! db run-id testname "" toptest-path)) (debug:print 2 "Setting up test run area") (debug:print 2 " - creating run area in " dfullp) (system (conc "mkdir -p " dfullp)) (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath) (system (conc "mkdir -p " lnkpath)) | > > > > | | | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | (if (not (equal? item-path "")) (db:test-set-rundir! db run-id testname "" toptest-path)) (debug:print 2 "Setting up test run area") (debug:print 2 " - creating run area in " dfullp) (system (conc "mkdir -p " dfullp)) (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath) (system (conc "mkdir -p " lnkpath)) ;; I suspect this section was deleting test directories under some ;; wierd sitations ;; (if (file-exists? (conc lnkpath "/" testname)) ;; (system (conc "rm -f " lnkpath "/" testname))) (system (conc "ln -sf " dfullp " " lnkpath "/" testname)) (if (directory? dfullp) (begin (let* ((cmd (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-path "/ " dfullp "/")) (status (system cmd))) (if (not (eq? status 0)) (debug:print 2 "ERROR: problem with running \"" cmd "\""))) |
︙ | ︙ |
Modified megatest.scm from [95886c7e30] to [6d9b67317c].
︙ | ︙ | |||
116 117 118 119 120 121 122 | (include "keys.scm") (include "items.scm") (include "db.scm") (include "configf.scm") (include "process.scm") (include "launch.scm") (include "runs.scm") | | | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | (include "keys.scm") (include "items.scm") (include "db.scm") (include "configf.scm") (include "process.scm") (include "launch.scm") (include "runs.scm") (include "runconfig.scm") (define *didsomething* #f) ;;====================================================================== ;; Misc setup stuff ;;====================================================================== |
︙ | ︙ | |||
360 361 362 363 364 365 366 | (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; now can find our db (set! db (open-db)) (change-directory work-area) | < | < < | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; now can find our db (set! db (open-db)) (change-directory work-area) (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 run-id test-name itemdat) (test-set-status! db run-id test-name "REMOTEHOSTSTART" "n/a" itemdat (args:get-arg "-m")) |
︙ | ︙ |
Added runconfig.scm version [1140c67c42].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (define (setup-env-defaults db fname run-id . already-seen) (let* ((keys (get-keys db)) (keyvals (get-key-vals db run-id)) (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")) (confdat (read-config fname)) (whatfound (make-hash-table)) (sections (list "default" thekey))) (debug:print 4 "Using key=\"" thekey "\"") (for-each (lambda (section) (let ((section-dat (hash-table-ref/default confdat section #f))) (if section-dat (for-each (lambda (envvar) (hash-table-set! whatfound section (+ (hash-table-ref/default whatfound section 0) 1)) (setenv envvar (cadr (assoc envvar section-dat)))) (map car section-dat))))) sections) (if (and (not (null? already-seen)) (not (car already-seen))) (begin (debug:print 2 "Key settings found in runconfig.config:") (for-each (lambda (fullkey) (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))))) (define (set-run-config-vars db run-id) (let ((runconfigf (conc *toppath* "/runconfigs.config"))) (if (file-exists? runconfigf) (setup-env-defaults db runconfigf run-id) (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))) |
Modified runs.scm from [bee21070b6] to [d0011041cc].
︙ | ︙ | |||
71 72 73 74 75 76 77 | (lambda (a . r) (set! res (cons (list->vector (cons a r)) res))) db (conc "SELECT " keystr " FROM runs WHERE runname like ? " key-patt ";") runnamepatt) (vector header res))) | | | > > > > | | 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 | (lambda (a . r) (set! res (cons (list->vector (cons a r)) res))) db (conc "SELECT " keystr " FROM runs WHERE runname like ? " key-patt ";") runnamepatt) (vector header res))) (define (register-test db run-id test-name item-path tags) (let ((item-paths (if (equal? item-path "") (list item-path) (list item-path "")))) (for-each (lambda (pth) (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status,tags) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a',?);" run-id test-name pth (conc "," (string-intersperse tags ",") ","))) item-paths ))) ;; (define db (open-db)) ;; (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer") (define (test-set-status! db run-id test-name state status itemdat-or-path . comment) (let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))) (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" |
︙ | ︙ | |||
311 312 313 314 315 316 317 | (set-megatest-env-vars db run-id) ;; these may be needed by the launching process (change-directory *toppath*) (let* ((test-path (conc *toppath* "/tests/" test-name)) (test-configf (conc test-path "/testconfig")) (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) (test-conf (if testexists (read-config test-configf) (make-hash-table))) (waiton (let ((w (config-lookup test-conf "requirements" "waiton"))) | | > > | 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 | (set-megatest-env-vars db run-id) ;; these may be needed by the launching process (change-directory *toppath*) (let* ((test-path (conc *toppath* "/tests/" test-name)) (test-configf (conc test-path "/testconfig")) (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) (test-conf (if testexists (read-config test-configf) (make-hash-table))) (waiton (let ((w (config-lookup test-conf "requirements" "waiton"))) (if (string? w)(string-split w)'()))) (tags (let ((t (config-lookup test-conf "setup" "tags"))) (if (string? t)(string-split t ",") '())))) (if (not testexists) (begin (debug:print 0 "ERROR: Can't find config file " test-configf) (exit 2)) ;; put top vars into convenient variables and open the db (let* (;; db is always at *toppath*/db/megatest.db (items (hash-table-ref/default test-conf "items" '())) |
︙ | ︙ | |||
356 357 358 359 360 361 362 | (if (runs:can-run-more-tests db) (begin (let loop2 ((ts (db:get-test-info db run-id test-name item-path)) ;; #f) (ct 0)) (if (and (not ts) (< ct 10)) (begin | | | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 | (if (runs:can-run-more-tests db) (begin (let loop2 ((ts (db:get-test-info db run-id test-name item-path)) ;; #f) (ct 0)) (if (and (not ts) (< ct 10)) (begin (register-test db run-id test-name item-path tags) (db:test-set-comment db run-id test-name item-path "") (loop2 (db:get-test-info db run-id test-name item-path) (+ ct 1))) (if ts (set! testdat ts) (begin (debug:print 0 "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping") |
︙ | ︙ |
Modified tests/tests/sqlitespeed/testconfig from [89f0ed3696] to [4da0db799e].
1 2 3 4 5 6 7 8 9 | [setup] runscript runscript.rb [requirements] waiton runfirst [items] MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am an ao ap aq ar as at au)] # BORKED | > | 1 2 3 4 5 6 7 8 9 10 | [setup] runscript runscript.rb tags non important,dumb junk [requirements] waiton runfirst [items] MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am an ao ap aq ar as at au)] # BORKED |
︙ | ︙ |