Overview
Comment: | Partial implementation of new filtering. Changed launch logic on finding script to execute for test |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
4856f788ea79092910445116fb326188 |
User & Date: | mrwellan on 2012-12-03 10:27:46 |
Other Links: | manifest | tags |
Context
2012-12-03
| ||
10:31 | Merging fork check-in: 9a0b5401b4 user: mrwellan tags: trunk | |
10:27 | Partial implementation of new filtering. Changed launch logic on finding script to execute for test check-in: 4856f788ea user: mrwellan tags: trunk | |
2012-11-26
| ||
10:24 | Bumped version check-in: 06080e4779 user: mrwellan tags: trunk, v1.5202 | |
Changes
Modified dashboard-tests.scm from [df43bcce90] to [0bfb3e05a8].
︙ | ︙ | |||
428 429 430 431 432 433 434 | (vector-ref x 4) (vector-ref x 5))) ;; time delta (sort (hash-table-values comprsteps) (lambda (a b) (let ((time-a (vector-ref a 1)) (time-b (vector-ref b 1))) (if (and (number? time-a)(number? time-b)) | | | > > > > > | 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 | (vector-ref x 4) (vector-ref x 5))) ;; time delta (sort (hash-table-values comprsteps) (lambda (a b) (let ((time-a (vector-ref a 1)) (time-b (vector-ref b 1))) (if (and (number? time-a)(number? time-b)) (if (< time-a time-b) #t (if (eq? time-a time-b) (string<? (conc (vector-ref a 2)) (conc (vector-ref b 2))) #f)) (string<? (conc time-a)(conc time-b)))))))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! stepsdat "VALUE" newval ))))) ;; "TITLE" newval))))) stepsdat)) ;; populate the Test Data panel (iup:frame #:title "Test Data" |
︙ | ︙ |
Modified db.scm from [f398e4db4e] to [340b92637a].
︙ | ︙ | |||
1596 1597 1598 1599 1600 1601 1602 | "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) "\nstatus: " (db:step-get-status step) "\ntime: " (db:step-get-event_time step)))) ;; (else (vector-set! record 1 (db:step-get-event_time step))) (sort steps (lambda (a b) | | > | | | | 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 | "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) "\nstatus: " (db:step-get-status step) "\ntime: " (db:step-get-event_time step)))) ;; (else (vector-set! record 1 (db:step-get-event_time step))) (sort steps (lambda (a b) (cond ((< (db:step-get-event_time a)(db:step-get-event_time b)) #t) ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) (< (db:step-get-id a) (db:step-get-id b))) (else #f))))) res))) ;;====================================================================== ;; M I S C M A N A G E M E N T I T E M S ;;====================================================================== ;; the new prereqs calculation, looks also at itempath if specified |
︙ | ︙ |
Modified launch.scm from [a7c83cebbb] to [dd3e168314].
︙ | ︙ | |||
51 52 53 54 55 56 57 | '()))) (define (launch:execute encoded-cmd) (let* ((cmdinfo (read (open-input-string (base64:base64-decode encoded-cmd))))) (setenv "MT_CMDINFO" encoded-cmd) (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) ;; (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1)) | | | > > > > > > > > | 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 | '()))) (define (launch:execute encoded-cmd) (let* ((cmdinfo (read (open-input-string (base64:base64-decode encoded-cmd))))) (setenv "MT_CMDINFO" encoded-cmd) (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) ;; (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1)) (let* ((testpath (assoc/default 'testpath cmdinfo)) ;; How is testpath different from work-area ?? (top-path (assoc/default 'toppath cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (ezsteps (assoc/default 'ezsteps cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) (test-id (assoc/default 'test-id cmdinfo)) (target (assoc/default 'target cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) (env-ovrd (assoc/default 'env-ovrd cmdinfo)) (set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar (runname (assoc/default 'runname cmdinfo)) (megatest (assoc/default 'megatest cmdinfo)) (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo)) (fullrunscript (if (not runscript) #f (if (substring-index "/" runscript) runscript ;; use unadultered if contains slashes (let ((fulln (conc testpath "/" runscript))) (if (and (file-exists? fulln) (file-execute-access? fulln)) fulln runscript))))) ;; assume it is on the path (rollup-status 0)) (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) (let ((varpairs (string-split set-vars ","))) |
︙ | ︙ |
Modified megatest.scm from [a0e0e04587] to [43202ebdc8].
︙ | ︙ | |||
114 115 116 117 118 119 120 | Examples # Get test path, use '.' to get a single path or a specific path/file pattern megatest -test-files 'logs/*.log' -target ubuntu/n%/no% :runname w49% -testpatt test_mt% Called as " (string-intersperse (argv) " ") " | | | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | Examples # Get test path, use '.' to get a single path or a specific path/file pattern megatest -test-files 'logs/*.log' -target ubuntu/n%/no% :runname w49% -testpatt test_mt% Called as " (string-intersperse (argv) " ") " Version " megatest-version ", built from " megatest-fossil-hash )) ;; -gui : start a gui interface ;; -config fname : override the runconfig file with fname ;; -kill-server host:port|pid : kill server specified by host:port or pid ;; process args (define remargs (args:get-args |
︙ | ︙ | |||
469 470 471 472 473 474 475 | (if (args:get-arg "-runall") (general-run-call "-runall" "run all tests" (lambda (target runname keys keynames keyvallst) (runs:run-tests target runname | | | < | 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 | (if (args:get-arg "-runall") (general-run-call "-runall" "run all tests" (lambda (target runname keys keynames keyvallst) (runs:run-tests target runname "%" (args:get-arg "-testpatt") user args:arg-hash)))) ;;====================================================================== ;; run one test ;;====================================================================== |
︙ | ︙ | |||
500 501 502 503 504 505 506 507 508 509 510 511 512 513 | (general-run-call "-runtests" "run a test" (lambda (target runname keys keynames keyvallst) (runs:run-tests target runname (args:get-arg "-runtests") user args:arg-hash)))) ;;====================================================================== ;; Rollup into a run ;;====================================================================== | > | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 | (general-run-call "-runtests" "run a test" (lambda (target runname keys keynames keyvallst) (runs:run-tests target runname (args:get-arg "-runtests") (args:get-arg "-testpatt") user args:arg-hash)))) ;;====================================================================== ;; Rollup into a run ;;====================================================================== |
︙ | ︙ |
Modified runs.scm from [6923ee1d25] to [ac5e3e62fc].
︙ | ︙ | |||
191 192 193 194 195 196 197 | (sqlite3:execute db "UPDATE runs SET state=?,status=? WHERE id=?;" state status res) res) (begin (debug:print 0 "ERROR: Called without all necessary keys") #f)))) ;; This is a duplicate of run-tests (which has been deprecated). Use this one instead of run tests. | | > > > > > | < | | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | (sqlite3:execute db "UPDATE runs SET state=?,status=? WHERE id=?;" state status res) res) (begin (debug:print 0 "ERROR: Called without all necessary keys") #f)))) ;; This is a duplicate of run-tests (which has been deprecated). Use this one instead of run tests. ;; keyvals. ;; ;; test-names: Comma separated patterns same as test-patts but used in selection ;; of tests to run. The item portions are not respected. ;; FIXME: error out if /patt specified ;; (define (runs:run-tests target runname test-names test-patts user flags) (let* ((db #f) (keys (cdb:remote-run db:get-keys #f)) (keyvallst (keys:target->keyval keys target)) (run-id (cdb:remote-run runs:register-run #f keys keyvallst runname "new" "n/a" user)) ;; test-name))) (deferred '()) ;; delay running these since they have a waiton clause ;; keepgoing is the defacto modality now, will add hit-n-run a bit later ;; (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) (runconfigf (conc *toppath* "/runconfigs.config")) (required-tests '()) (test-records (make-hash-table))) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (if (file-exists? runconfigf) (open-run-close setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* "pre-launch-env-vars") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) ;; look up all tests matching the comma separated list of globs in ;; test-patts (using % as wildcard) (set! test-names (tests:get-valid-tests *toppath* test-names)) (set! test-names (delete-duplicates test-names)) (debug:print-info 0 "test names " test-names) ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if ;; -keepgoing is specified (if (eq? *passnum* 0) |
︙ | ︙ |
Modified tests.scm from [4543da4028] to [661a4dba80].
︙ | ︙ | |||
25 26 27 28 29 30 31 | (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") | | < | | | | | | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") (define (tests:get-valid-tests testsdir test-patts) ;; #!key (test-names '())) (let ((tests (glob (conc testsdir "/tests/*")))) ;; " (string-translate patt "%" "*"))))) (set! tests (filter (lambda (test)(file-exists? (conc test "/testconfig"))) tests)) (delete-duplicates (filter (lambda (testname) (tests:match test-patts testname #f)) (map (lambda (testp) (last (string-split testp "/"))) tests))))) ;; tests:glob-like-match (define (tests:glob-like-match patt str) (let ((like (substring-index "%" patt))) (let* ((notpatt (equal? (substring-index "~" patt) 0)) (newpatt (if notpatt (substring patt 1) patt)) (finpatt (if like |
︙ | ︙ | |||
303 304 305 306 307 308 309 | (print "Obtained lock for " outputfilename) (print "Failed to obtain lock for " outputfilename)) (let ((oup (open-output-file outputfilename)) (counts (make-hash-table)) (statecounts (make-hash-table)) (outtxt "") (tot 0) | | | 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 | (print "Obtained lock for " outputfilename) (print "Failed to obtain lock for " outputfilename)) (let ((oup (open-output-file outputfilename)) (counts (make-hash-table)) (statecounts (make-hash-table)) (outtxt "") (tot 0) (testdat (cdb:remote-run db:test-get-records-for-index-file #f run-id test-name))) (with-output-to-port oup (lambda () (set! outtxt (conc outtxt "<html><title>Summary: " test-name "</title><body><h2>Summary for " test-name "</h2>")) (for-each (lambda (testrecord) |
︙ | ︙ |