Check-in [6654e3905e]
Not logged in
Overview
SHA1 Hash:6654e3905edd7eed62adb123c8c0e6222fa56278
Date: 2011-07-19 00:08:45
User: matt
Comment:Added support for tags to megatest. Dashboard not done yet
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified db.scm from [88fcf141f544e4bb] to [b0a0444891f03e0e].

80 (sqlite3:execute db "CREATE TABLE extradat (id INTEGER PRIMARY KEY, ru 80 (sqlite3:execute db "CREATE TABLE extradat (id INTEGER PRIMARY KEY, ru 81 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var 81 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var 82 CONSTRAINT metadat_constraint UNIQUE (id,var)) 82 CONSTRAINT metadat_constraint UNIQUE (id,var)) 83 (db:set-var db "MEGATEST_VERSION" megatest-version) 83 (db:set-var db "MEGATEST_VERSION" megatest-version) 84 (sqlite3:execute db "CREATE TABLE access_log (id INTEGER PRIMARY KEY, 84 (sqlite3:execute db "CREATE TABLE access_log (id INTEGER PRIMARY KEY, 85 db)) 85 db)) 86 86 87 (define (patch-db db) | 87 (define (patch-db db)heh 88 (handle-exceptions 88 (handle-exceptions 89 exn 89 exn 90 (begin 90 (begin 91 (print "Exception: " exn) 91 (print "Exception: " exn) 92 (print "ERROR: Possible out of date schema, attempting to add table metadat 92 (print "ERROR: Possible out of date schema, attempting to add table metadat 93 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT 93 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT 94 CONSTRAINT metadat_constraint UNIQUE (id,var)) 94 CONSTRAINT metadat_constraint UNIQUE (id,var))

Modified launch.scm from [5bfe54be51fe08c1] to [f4b3156c753a8595].

18 (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) 18 (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) 19 (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) 19 (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) 20 (if *toppath* 20 (if *toppath* 21 (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated 21 (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated 22 (debug:print 0 "ERROR: failed to find the top path to your run setup.")) 22 (debug:print 0 "ERROR: failed to find the top path to your run setup.")) 23 *toppath*) 23 *toppath*) 24 24 25 (define (setup-env-defaults db fname run-id . already-seen) < 26 (let* ((keys (get-keys db)) < 27 (keyvals (get-key-vals db run-id)) < 28 (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) < 29 (confdat (read-config fname)) < 30 (whatfound (make-hash-table)) < 31 (sections (list "default" thekey))) < 32 (debug:print 4 "Using key=\"" thekey "\"") < 33 (for-each < 34 (lambda (section) < 35 (let ((section-dat (hash-table-ref/default confdat section #f))) < 36 (if section-dat < 37 (for-each < 38 (lambda (envvar) < 39 (hash-table-set! whatfound section (+ (hash-table-ref/default wh < 40 (setenv envvar (cadr (assoc envvar section-dat)))) < 41 (map car section-dat))))) < 42 sections) < 43 (if (and (not (null? already-seen)) < 44 (not (car already-seen))) < 45 (begin < 46 (debug:print 2 "Key settings found in runconfig.config:") < 47 (for-each (lambda (fullkey) < 48 (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table- < 49 sections) < 50 (debug:print 2 "---") < 51 (set! *already-seen-runconfig-info* #t))))) < 52 < 53 (define (get-best-disk confdat) 25 (define (get-best-disk confdat) 54 (let* ((disks (hash-table-ref/default confdat "disks" #f)) 26 (let* ((disks (hash-table-ref/default confdat "disks" #f)) 55 (best #f) 27 (best #f) 56 (bestsize 0)) 28 (bestsize 0)) 57 (if disks 29 (if disks 58 (for-each 30 (for-each 59 (lambda (disk-num) 31 (lambda (disk-num) ................................................................................................................................................................................ 90 (if (not (equal? item-path "")) 62 (if (not (equal? item-path "")) 91 (db:test-set-rundir! db run-id testname "" toptest-path)) 63 (db:test-set-rundir! db run-id testname "" toptest-path)) 92 (debug:print 2 "Setting up test run area") 64 (debug:print 2 "Setting up test run area") 93 (debug:print 2 " - creating run area in " dfullp) 65 (debug:print 2 " - creating run area in " dfullp) 94 (system (conc "mkdir -p " dfullp)) 66 (system (conc "mkdir -p " dfullp)) 95 (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath) 67 (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath) 96 (system (conc "mkdir -p " lnkpath)) 68 (system (conc "mkdir -p " lnkpath)) > 69 > 70 ;; I suspect this section was deleting test directories under some > 71 ;; wierd sitations > 72 97 (if (file-exists? (conc lnkpath "/" testname)) | 73 ;; (if (file-exists? (conc lnkpath "/" testname)) 98 (system (conc "rm -f " lnkpath "/" testname))) | 74 ;; (system (conc "rm -f " lnkpath "/" testname))) 99 (system (conc "ln -sf " dfullp " " lnkpath "/" testname)) 75 (system (conc "ln -sf " dfullp " " lnkpath "/" testname)) 100 (if (directory? dfullp) 76 (if (directory? dfullp) 101 (begin 77 (begin 102 (let* ((cmd (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " tes 78 (let* ((cmd (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " tes 103 (status (system cmd))) 79 (status (system cmd))) 104 (if (not (eq? status 0)) 80 (if (not (eq? status 0)) 105 (debug:print 2 "ERROR: problem with running \"" cmd "\""))) 81 (debug:print 2 "ERROR: problem with running \"" cmd "\"")))

Modified megatest.scm from [95886c7e3041b227] to [6d9b67317c27b3ea].

116 (include "keys.scm") 116 (include "keys.scm") 117 (include "items.scm") 117 (include "items.scm") 118 (include "db.scm") 118 (include "db.scm") 119 (include "configf.scm") 119 (include "configf.scm") 120 (include "process.scm") 120 (include "process.scm") 121 (include "launch.scm") 121 (include "launch.scm") 122 (include "runs.scm") 122 (include "runs.scm") 123 ;; (include "gui.scm") | 123 (include "runconfig.scm") 124 124 125 (define *didsomething* #f) 125 (define *didsomething* #f) 126 126 127 ;;====================================================================== 127 ;;====================================================================== 128 ;; Misc setup stuff 128 ;; Misc setup stuff 129 ;;====================================================================== 129 ;;====================================================================== 130 130 ................................................................................................................................................................................ 360 (if (not (setup-for-run)) 360 (if (not (setup-for-run)) 361 (begin 361 (begin 362 (debug:print 0 "Failed to setup, exiting") 362 (debug:print 0 "Failed to setup, exiting") 363 (exit 1))) 363 (exit 1))) 364 ;; now can find our db 364 ;; now can find our db 365 (set! db (open-db)) 365 (set! db (open-db)) 366 (change-directory work-area) 366 (change-directory work-area) 367 (let ((runconfigf (conc *toppath* "/runconfigs.config"))) | 367 (set-run-config-vars db run-id) 368 (if (file-exists? runconfigf) < 369 (setup-env-defaults db runconfigf run-id) < 370 (debug:print 0 "WARNING: You do not have a run config file: " < 371 ;; environment overrides are done *before* the remaining critical en 368 ;; environment overrides are done *before* the remaining critical en 372 (alist->env-vars env-ovrd) 369 (alist->env-vars env-ovrd) 373 (set-megatest-env-vars db run-id) 370 (set-megatest-env-vars db run-id) 374 (set-item-env-vars itemdat) 371 (set-item-env-vars itemdat) 375 (save-environment-as-files "megatest") 372 (save-environment-as-files "megatest") 376 (test-set-meta-info db run-id test-name itemdat) 373 (test-set-meta-info db run-id test-name itemdat) 377 (test-set-status! db run-id test-name "REMOTEHOSTSTART" "n/a" itemda 374 (test-set-status! db run-id test-name "REMOTEHOSTSTART" "n/a" itemda

Added runconfig.scm version [1140c67c4203134a]

> 1 ;;====================================================================== > 2 ;; read a config file, loading only the section pertinent > 3 ;; to this run field1val/field2val/field3val ... > 4 ;;====================================================================== > 5 (define (setup-env-defaults db fname run-id . already-seen) > 6 (let* ((keys (get-keys db)) > 7 (keyvals (get-key-vals db run-id)) > 8 (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) > 9 (confdat (read-config fname)) > 10 (whatfound (make-hash-table)) > 11 (sections (list "default" thekey))) > 12 (debug:print 4 "Using key=\"" thekey "\"") > 13 (for-each > 14 (lambda (section) > 15 (let ((section-dat (hash-table-ref/default confdat section #f))) > 16 (if section-dat > 17 (for-each > 18 (lambda (envvar) > 19 (hash-table-set! whatfound section (+ (hash-table-ref/default wh > 20 (setenv envvar (cadr (assoc envvar section-dat)))) > 21 (map car section-dat))))) > 22 sections) > 23 (if (and (not (null? already-seen)) > 24 (not (car already-seen))) > 25 (begin > 26 (debug:print 2 "Key settings found in runconfig.config:") > 27 (for-each (lambda (fullkey) > 28 (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table- > 29 sections) > 30 (debug:print 2 "---") > 31 (set! *already-seen-runconfig-info* #t))))) > 32 > 33 (define (set-run-config-vars db run-id) > 34 (let ((runconfigf (conc *toppath* "/runconfigs.config"))) > 35 (if (file-exists? runconfigf) > 36 (setup-env-defaults db runconfigf run-id) > 37 (debug:print 0 "WARNING: You do not have a run config file: " runconfigf > 38

Modified runs.scm from [bee21070b6fe9fcf] to [d0011041cc432f4d].

71 (lambda (a . r) 71 (lambda (a . r) 72 (set! res (cons (list->vector (cons a r)) res))) 72 (set! res (cons (list->vector (cons a r)) res))) 73 db 73 db 74 (conc "SELECT " keystr " FROM runs WHERE runname like ? " key-patt ";") 74 (conc "SELECT " keystr " FROM runs WHERE runname like ? " key-patt ";") 75 runnamepatt) 75 runnamepatt) 76 (vector header res))) 76 (vector header res))) 77 77 78 (define (register-test db run-id test-name item-path) | 78 (define (register-test db run-id test-name item-path tags) 79 (let ((item-paths (if (equal? item-path "") 79 (let ((item-paths (if (equal? item-path "") 80 (list item-path) 80 (list item-path) 81 (list item-path "")))) 81 (list item-path "")))) 82 (for-each 82 (for-each 83 (lambda (pth) 83 (lambda (pth) 84 (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_t | 84 (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_t > 85 run-id > 86 test-name > 87 pth > 88 (conc "," (string-intersperse tags ",") ","))) 85 item-paths))) | 89 item-paths ))) 86 90 87 ;; (define db (open-db)) 91 ;; (define db (open-db)) 88 ;; (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer") 92 ;; (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer") 89 93 90 (define (test-set-status! db run-id test-name state status itemdat-or-path . com 94 (define (test-set-status! db run-id test-name state status itemdat-or-path . com 91 (let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->pat 95 (let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->pat 92 (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime(' 96 (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime(' ................................................................................................................................................................................ 311 (set-megatest-env-vars db run-id) ;; these may be needed by the launching proc 315 (set-megatest-env-vars db run-id) ;; these may be needed by the launching proc 312 (change-directory *toppath*) 316 (change-directory *toppath*) 313 (let* ((test-path (conc *toppath* "/tests/" test-name)) 317 (let* ((test-path (conc *toppath* "/tests/" test-name)) 314 (test-configf (conc test-path "/testconfig")) 318 (test-configf (conc test-path "/testconfig")) 315 (testexists (and (file-exists? test-configf)(file-read-access? test-c 319 (testexists (and (file-exists? test-configf)(file-read-access? test-c 316 (test-conf (if testexists (read-config test-configf) (make-hash-tabl 320 (test-conf (if testexists (read-config test-configf) (make-hash-tabl 317 (waiton (let ((w (config-lookup test-conf "requirements" "waiton" 321 (waiton (let ((w (config-lookup test-conf "requirements" "waiton" 318 (if (string? w)(string-split w)'())))) | 322 (if (string? w)(string-split w)'()))) > 323 (tags (let ((t (config-lookup test-conf "setup" "tags"))) > 324 (if (string? t)(string-split t ",") '())))) 319 (if (not testexists) 325 (if (not testexists) 320 (begin 326 (begin 321 (debug:print 0 "ERROR: Can't find config file " test-configf) 327 (debug:print 0 "ERROR: Can't find config file " test-configf) 322 (exit 2)) 328 (exit 2)) 323 ;; put top vars into convenient variables and open the db 329 ;; put top vars into convenient variables and open the db 324 (let* (;; db is always at *toppath*/db/megatest.db 330 (let* (;; db is always at *toppath*/db/megatest.db 325 (items (hash-table-ref/default test-conf "items" '())) 331 (items (hash-table-ref/default test-conf "items" '())) ................................................................................................................................................................................ 356 (if (runs:can-run-more-tests db) 362 (if (runs:can-run-more-tests db) 357 (begin 363 (begin 358 (let loop2 ((ts (db:get-test-info db run-id test-name item-p 364 (let loop2 ((ts (db:get-test-info db run-id test-name item-p 359 (ct 0)) 365 (ct 0)) 360 (if (and (not ts) 366 (if (and (not ts) 361 (< ct 10)) 367 (< ct 10)) 362 (begin 368 (begin 363 (register-test db run-id test-name item-path) | 369 (register-test db run-id test-name item-path tags) 364 (db:test-set-comment db run-id test-name item-path " 370 (db:test-set-comment db run-id test-name item-path " 365 (loop2 (db:get-test-info db run-id test-name item-pa 371 (loop2 (db:get-test-info db run-id test-name item-pa 366 (+ ct 1))) 372 (+ ct 1))) 367 (if ts 373 (if ts 368 (set! testdat ts) 374 (set! testdat ts) 369 (begin 375 (begin 370 (debug:print 0 "WARNING: Couldn't register test 376 (debug:print 0 "WARNING: Couldn't register test

Modified tests/tests/sqlitespeed/testconfig from [89f0ed3696c07e42] to [4da0db799e7eb134].

1 [setup] 1 [setup] 2 runscript runscript.rb 2 runscript runscript.rb > 3 tags non important,dumb junk 3 4 4 [requirements] 5 [requirements] 5 waiton runfirst 6 waiton runfirst 6 7 7 [items] 8 [items] 8 MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am 9 MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am 9 # BORKED 10 # BORKED 10 11