Difference From 5cecd7e1d48b51fc To root:5cecd7e1d48b51fc
2011-08-11
| ||
01:45 | Merged in rollup runs to trunk. Actual rollup of runs not completed yet check-in: d7ffcddcac user: matt tags: trunk, v1.20 | |
01:44 | Updated dashboard to show the test meta data check-in: 425cf09f05 user: matt tags: rollup-runs | |
00:53 | Added test_meta data populating check-in: 5cecd7e1d4 user: matt tags: rollup-runs | |
2011-08-10
| ||
21:57 | Rollup runs, clean up tests check-in: 3e4d4b9027 user: mrwellan tags: rollup-runs | |
2011-08-08
| ||
14:45 | Rollup runs from past N days to new runname, started implementation check-in: 8757213827 user: mrwellan tags: rollup-runs | |
2011-08-06
| ||
23:42 | Added debugging statements, regenerated docs check-in: 6b1fa57fcf user: matt tags: trunk | |
2011-08-04
| ||
09:56 | Added support for using the shell when launching a command (vs. directly kicking off the process) check-in: dc5aae878a user: mrwellan tags: trunk | |
Modified Makefile from [6d582f371e] to [6bee1e6a16].
1 2 3 4 5 | 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 | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | 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 csc dashboard.scm $(PREFIX)/bin/megatest : megatest @echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change sleep 5 cp megatest $(PREFIX)/bin/megatest $(PREFIX)/bin/dashboard : dashboard cp dashboard $(PREFIX)/bin/dashboard install : $(PREFIX)/bin/megatest $(PREFIX)/bin/dashboard test: megatest tests/tests.scm cd tests;csi -I .. -b -n tests.scm |
Modified configf.scm from [2d522c454c] to [50f8f33c26].
︙ | ︙ | |||
23 24 25 26 27 28 29 | (list path fullpath configname) (let ((remcwd (take dir (- (length dir) 1)))) (if (null? remcwd) (list #f #f #f) ;; #f #f) (loop remcwd)))))))) (define (config:assoc-safe-add alist key val) | | | | < | < < | | | | | < < < < < < < < < < | < < < | < < | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 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 | (list path fullpath configname) (let ((remcwd (take dir (- (length dir) 1)))) (if (null? remcwd) (list #f #f #f) ;; #f #f) (loop remcwd)))))))) (define (config:assoc-safe-add alist key val) (let ((newalist (filter (lambda (x)(not (equal? key x))) alist))) (append alist (list (list key val))))) ;; read a config file, returns two level hierarchial hash-table, ;; adds to ht if given (must be #f otherwise) (define (read-config path . ht) (if (not (file-exists? path)) (if (null? ht)(make-hash-table) (car ht)) (let ((inp (open-input-file path)) (res (if (null? ht)(make-hash-table)(car ht))) (include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) (section-rx (regexp "^\\[(.*)\\]\\s*$")) (blank-l-rx (regexp "^\\s*$")) (key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) (key-val-pr (regexp "^(\\S+)\\s+(.*)$")) (comment-rx (regexp "^\\s*#.*"))) (let loop ((inl (read-line inp)) (curr-section-name "default")) (if (eof-object? inl) (begin (close-input-port inp) res) (regex-case inl (comment-rx _ (loop (read-line inp) curr-section-name)) (blank-l-rx _ (loop (read-line inp) curr-section-name)) (include-rx ( x include-file ) (begin (read-config include-file res) (loop (read-line inp) curr-section-name))) (section-rx ( x section-name ) (loop (read-line inp) section-name)) (key-sys-pr ( x key cmd ) (let ((alist (hash-table-ref/default res curr-section-name '())) (val (let* ((cmdres (cmd-run->list cmd)) (status (cadr cmdres)) (res (car cmdres))) (if (not (eq? status 0)) (begin (debug:print 0 "ERROR: problem with " inl ", return code " status) (exit 1))) (if (null? res) "" (string-intersperse res " "))))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key val)) ;; (append alist (list (list key val)))) (loop (read-line inp) curr-section-name))) (key-val-pr ( x key val ) (let ((alist (hash-table-ref/default res curr-section-name '()))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key val)) ;; (append alist (list (list key val)))) (loop (read-line inp) curr-section-name))) (else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"") (loop (read-line inp) curr-section-name)))))))) (define (find-and-read-config fname) (let* ((curr-dir (current-directory)) (configinfo (find-config fname)) (toppath (car configinfo)) (configfile (cadr configinfo))) (if toppath (change-directory toppath)) |
︙ | ︙ |
Modified db.scm from [d996c6fe14] to [603c4ba3d8].
︙ | ︙ | |||
77 78 79 80 81 82 83 | 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) | | < > < | | | | | < < < < < < < < < < < < < | > | 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 | 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)) ;;====================================================================== ;; TODO: ;; put deltas into an assoc list with version numbers ;; apply all from last to current ;;====================================================================== (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));") (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"))) (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) ))) ;;====================================================================== ;; meta get and set vars ;;====================================================================== ;; returns number if string->number is successful, string otherwise (define (db:get-var db var) |
︙ | ︙ | |||
349 350 351 352 353 354 355 | ;; (define (db:test-set-rundir! db run-id testname item-path rundir) (sqlite3:execute db "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" rundir run-id testname item-path)) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 336 337 338 339 340 341 342 343 344 345 346 347 348 349 | ;; (define (db:test-set-rundir! db run-id testname item-path rundir) (sqlite3:execute db "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" rundir run-id testname item-path)) ;;====================================================================== ;; Steps ;;====================================================================== ;; Run steps ;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time (define (make-db:step)(make-vector 6)) (define-inline (db:step-get-id vec) (vector-ref vec 0)) |
︙ | ︙ | |||
484 485 486 487 488 489 490 | ;; tests) ;; (filter (lambda (x) ;; (not (hash-table-ref/default non-completed (db:test-get-testname x) #f))) ;; tests))) ;; (pre-dep-names (map db:test-get-testname completed-tests)) ;; (result (lset-difference string=? waiton pre-dep-names))) ;; (print "pre-dep-names: " pre-dep-names " waiton: " waiton " result: " result) | < | 427 428 429 430 431 432 433 | ;; tests) ;; (filter (lambda (x) ;; (not (hash-table-ref/default non-completed (db:test-get-testname x) #f))) ;; tests))) ;; (pre-dep-names (map db:test-get-testname completed-tests)) ;; (result (lset-difference string=? waiton pre-dep-names))) ;; (print "pre-dep-names: " pre-dep-names " waiton: " waiton " result: " result) |
Modified megatest-version.scm from [ebeb01abfb] to [c09e9a5825].
|
| < < | | 1 | (define megatest-version 1.19) |
Modified megatest.scm from [8f3220a6de] to [fdec59eebf].
︙ | ︙ | |||
52 53 54 55 56 57 58 | 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 | < < < | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | 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 |
︙ | ︙ | |||
89 90 91 92 93 94 95 | "-itempatt" "-setlog" "-set-toplog" "-runstep" "-logpro" "-m" "-rerun" | < < < < | 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 | "-itempatt" "-setlog" "-set-toplog" "-runstep" "-logpro" "-m" "-rerun" "-debug" ;; for *verbosity* > 2 ) (list "-h" "-force" "-xterm" "-showkeys" "-test-status" "-summarize-items" "-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") |
︙ | ︙ | |||
263 264 265 266 267 268 269 | ;; else ;; put task in deferred queue ;; if still ok to run tasks ;; process deferred tasks per above steps ;; run all tests are are Not COMPLETED and PASS or CHECK (if (args:get-arg "-runall") | | > > > | > > > > > > > > | < | | | | | < < < < < < | < < | > | > > > > | | > > > > > | < > > | | > > > > > > > | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 | ;; else ;; put task in deferred queue ;; if still ok to run tasks ;; process deferred tasks per above steps ;; run all tests are are Not COMPLETED and PASS or CHECK (if (args:get-arg "-runall") (if (not (args:get-arg ":runname")) (begin (debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname") (exit 2)) (let* ((db (if (setup-for-run) (open-db) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))))) (if (not (car *configinfo*)) (begin (debug:print 0 "ERROR: Attempted to run a test but run area config file not found") (exit 1)) ;; put test parameters into convenient variables (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now (debug:print 1 "INFO: Attempting to start the following tests...") (debug:print 1 " " (string-intersperse test-names ",")) (run-tests db test-names))) ;; (run-waiting-tests db) (sqlite3:finalize! db) (set! *didsomething* #t)))) ;;====================================================================== ;; run one test ;;====================================================================== ;; 1. find the config file ;; 2. change to the test directory ;; 3. update the db with "test started" status, set running host ;; 4. process launch the test ;; - monitor the process, update stats in the db every 2^n minutes ;; 5. as the test proceeds internally it calls megatest as each step is ;; started and completed ;; - step started, timestamp ;; - step completed, exit status, timestamp ;; 6. test phone home ;; - if test run time > allowed run time then kill job ;; - if cannot access db > allowed disconnect time then kill job (define (runtests) (if (not (args:get-arg ":runname")) (begin (debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname") (exit 2)) (let ((db #f)) (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (set! db (open-db)) (if (not (car *configinfo*)) (begin (debug:print 0 "ERROR: Attempted to run a test but run area config file not found") (exit 1)) ;; put test parameters into convenient variables (let* ((test-names (string-split (args:get-arg "-runtests") ","))) (run-tests db test-names))) ;; run-waiting-tests db) (sqlite3:finalize! db) ;; (run-waiting-tests #f) (set! *didsomething* #t)))) (if (args:get-arg "-runtests") (runtests)) ;;====================================================================== ;; execute the test ;; - gets called on remote host ;; - receives info from the -execute param ;; - passes info to steps via MT_CMDINFO env var (future is to use a dot file) ;; - gathers host info and |
︙ | ︙ | |||
490 491 492 493 494 495 496 | (if (vector-ref exit-info 1) ;; look at the exit-status (if (and (not kill-job?) (eq? (vector-ref exit-info 2) 0)) "PASS" "FAIL") "FAIL") itemdat (args:get-arg "-m")))) ;; for automated creation of the rollup html file this is a good place... | < | | 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 | (if (vector-ref exit-info 1) ;; look at the exit-status (if (and (not kill-job?) (eq? (vector-ref exit-info 2) 0)) "PASS" "FAIL") "FAIL") itemdat (args:get-arg "-m")))) ;; for automated creation of the rollup html file this is a good place... (tests:summarize-items db run-id test-name #f) ;; don't force - just update if no ) (mutex-unlock! m) ;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (conc test-name "-run.log")))) ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n") (sqlite3:finalize! db) |
︙ | ︙ |
Modified runs.scm from [a71e17f8a8] to [80fea350e5].
︙ | ︙ | |||
424 425 426 427 428 429 430 | (if (>= *verbosity* 1)(pp allitems)) (if (>= *verbosity* 5) (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"))) | < < < < < < < < < < < < < < < < < < | 424 425 426 427 428 429 430 431 432 433 434 435 436 437 | (if (>= *verbosity* 1)(pp allitems)) (if (>= *verbosity* 5) (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"))) ;; braindead work-around for poorly specified allitems list BUG!!! FIXME (if (null? allitems)(set! allitems '(()))) (let loop ((itemdat (car allitems)) (tal (cdr allitems))) ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer")) ;; Handle lists of items (let* ((item-path (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/")) |
︙ | ︙ | |||
649 650 651 652 653 654 655 | ;; (if (null? (glob (conc runpath "/*"))) ;; (begin ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) )))) )) runs))) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 631 632 633 634 635 636 637 | ;; (if (null? (glob (conc runpath "/*"))) ;; (begin ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) )))) )) runs))) |
Modified tests/test.config from [5ec648d029] to [50c4aca439].
︙ | ︙ | |||
15 16 17 18 19 20 21 | [include a file that doesn't exist] blah nada # now inlcude a file tha tdoes exist [include megatest.config] | < < < < < < < < < < | 15 16 17 18 19 20 21 | [include a file that doesn't exist] blah nada # now inlcude a file tha tdoes exist [include megatest.config] |
Modified tests/tests.scm from [8fcf733fb4] to [51a14a8524].
︙ | ︙ | |||
16 17 18 19 20 21 22 | (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 "./"))) (test "Get best dir" #t (let ((bestdir (get-best-disk conffile))) (or (equal? "./" bestdir) (equal? "/tmp" bestdir)))) | < | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | (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 "./"))) (test "Get best dir" #t (let ((bestdir (get-best-disk conffile))) (or (equal? "./" bestdir) (equal? "/tmp" bestdir)))) ;; db (define row (vector "a" "b" "c" "blah")) (define header (list "col1" "col2" "col3" "col4")) (test "Get row by header" "blah" (db:get-value-by-header row header "col4")) ;; (define *toppath* "tests") |
︙ | ︙ | |||
59 60 61 62 63 64 65 | (and (file-exists? "nada.sh") (file-exists? "nada.csh")))) (test "get all legal tests" (list "runfirst" "runwithfirst" "singletest" "singletest2" "sqlitespeed") (sort (get-all-legal-tests) string<=?)) (test "register-test, test info" "NOT_STARTED" (begin | | | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | (and (file-exists? "nada.sh") (file-exists? "nada.csh")))) (test "get all legal tests" (list "runfirst" "runwithfirst" "singletest" "singletest2" "sqlitespeed") (sort (get-all-legal-tests) string<=?)) (test "register-test, test info" "NOT_STARTED" (begin (register-test *db* 1 "nada" "") (test:get-state (db:get-test-info *db* 1 "nada" "")))) (test "get-keys" "sysname" (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0))))))) (define remargs (args:get-args '("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada") (list ":runname" ":state" ":status") |
︙ | ︙ |
Modified tests/tests/runfirst/testconfig from [f0b52bc3c6] to [9a8e30b98e].
︙ | ︙ | |||
10 11 12 13 14 15 16 | [items] SEASON summer winter fall spring [itemstable] BLOCK a b TOCK 1 2 | < < < < < < < < | 10 11 12 13 14 15 16 | [items] SEASON summer winter fall spring [itemstable] BLOCK a b TOCK 1 2 |