Overview
Comment: | Minor optimization. Enabled key env vars in using -show-runconfig |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.54 |
Files: | files | file ages | folders |
SHA1: |
12652f0dbdda1107dbc908d1ff6b4924 |
User & Date: | matt on 2013-05-05 00:35:53 |
Other Links: | branch diff | manifest | tags |
Context
2013-05-05
| ||
00:43 | Added MT_RUN_AREA_HOME for -show-runconfigs check-in: 2d38067787 user: matt tags: v1.54, v1.5421 | |
00:35 | Minor optimization. Enabled key env vars in using -show-runconfig check-in: 12652f0dbd user: matt tags: v1.54 | |
2013-05-04
| ||
23:56 | Simplified testpatt vs. runtests check-in: 8574e9978e user: matt tags: v1.54, v1.5421 | |
Changes
Modified db.scm from [df4224a57c] to [98d99ca28b].
︙ | ︙ | |||
519 520 521 522 523 524 525 526 527 528 529 530 531 532 | (if (equal? hed field) (vector-ref row n) (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1))))))) ;;====================================================================== ;; R U N S ;;====================================================================== ;; keys list to key1,key2,key3 ... (define (runs:get-std-run-fields keys remfields) (let* ((header (append (map key:get-fieldname keys) remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) | > > > > > > > > > > > > > > > > > > > > | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | (if (equal? hed field) (vector-ref row n) (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1))))))) ;;====================================================================== ;; R U N S ;;====================================================================== (define (db:get-run-name-from-id db run-id) (let ((res #f)) (sqlite3:for-each-row (lambda (runname) (set! res runname)) db "SELECT runname FROM runs WHERE id=?;" run-id) res)) (define (db:get-run-key-val db run-id key) (let ((res #f)) (sqlite3:for-each-row (lambda (val) (set! res val)) db (conc "SELECT " (key:get-fieldname key) " FROM runs WHERE id=?;") run-id) res)) ;; keys list to key1,key2,key3 ... (define (runs:get-std-run-fields keys remfields) (let* ((header (append (map key:get-fieldname keys) remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) |
︙ | ︙ |
Modified megatest.scm from [a6c4f0612e] to [a2be3fd7a9].
︙ | ︙ | |||
411 412 413 414 415 416 417 | (for-each (lambda (x) ;; (print "[" x "]")) (print x)) targets) (set! *didsomething* #t))) (if (args:get-arg "-show-runconfig") | > | > > > > > > | | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 | (for-each (lambda (x) ;; (print "[" x "]")) (print x)) targets) (set! *didsomething* #t))) (if (args:get-arg "-show-runconfig") (let* ((keys (cdb:remote-run get-keys #f)) (target (if (args:get-arg "-reqtarg") (args:get-arg "-reqtarg") (if (args:get-arg "-target") (args:get-arg "-target") #f))) (key-vals (if target (keys:target->keyval keys target) #f)) (sections (if target (list "default" target) #f)) (data (begin (if key-vals (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals)) (read-config "runconfigs.config" #f #t sections: sections)))) ;; keep this one local (cond ((not (args:get-arg "-dumpmode")) (pp (hash-table->alist data))) ((string=? (args:get-arg "-dumpmode") "json") (json-write data)) |
︙ | ︙ |
Modified run-tests-queue-classic.scm from [70e6801543] to [7273016cde].
︙ | ︙ | |||
220 221 222 223 224 225 226 | ((or (null? prereqs-not-met) ;; all prereqs met, fire off the test ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch (and (eq? testmode 'toplevel) (null? non-completed))) (let ((test-name (tests:testqueue-get-testname test-record))) (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_RUNNAME" runname) | | | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 | ((or (null? prereqs-not-met) ;; all prereqs met, fire off the test ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch (and (eq? testmode 'toplevel) (null? non-completed))) (let ((test-name (tests:testqueue-get-testname test-record))) (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_RUNNAME" runname) (set-megatest-env-vars run-id inrunname: runname) ;; these may be needed by the launching process (let ((items-list (items:get-items-from-config tconfig))) (if (list? items-list) (begin (tests:testqueue-set-items! test-record items-list) ;; (thread-sleep! *global-delta*) (loop hed tal reruns)) (begin |
︙ | ︙ |
Modified runs.scm from [5f0f872d62] to [67d716378c].
︙ | ︙ | |||
65 66 67 68 69 70 71 | (vector header res))) (define (runs:test-get-full-path test) (let* ((testname (db:test-get-testname test)) (itempath (db:test-get-item-path test))) (conc testname (if (equal? itempath "") "" (conc "(" itempath ")"))))) | < < < < < < < < < < < < < < < < < < < < | | | | 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 90 91 92 93 94 95 96 97 98 99 | (vector header res))) (define (runs:test-get-full-path test) (let* ((testname (db:test-get-testname test)) (itempath (db:test-get-item-path test))) (conc testname (if (equal? itempath "") "" (conc "(" itempath ")"))))) (define (set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)) (let ((keys (if inkeys inkeys (cdb:remote-run db:get-keys #f))) (vals (hash-table-ref/default *env-vars-by-run-id* run-id #f))) ;; get the info from the db and put it in the cache (if (not vals) (let ((ht (make-hash-table))) (hash-table-set! *env-vars-by-run-id* run-id ht) (set! vals ht) (for-each (lambda (key) (hash-table-set! vals key (cdb:remote-run db:get-run-key-val #f run-id key))) keys))) ;; from the cached data set the vars (hash-table-for-each vals (lambda (key val) (debug:print 2 "setenv " (key:get-fieldname key) " " val) (setenv (key:get-fieldname key) val))) (alist->env-vars (hash-table-ref/default *configdat* "env-override" '())) ;; Lets use this as an opportunity to put MT_RUNNAME in the environment (setenv "MT_RUNNAME" (if inrunname inrunname (cdb:remote-run db:get-run-name-from-id #f run-id))) (setenv "MT_RUN_AREA_HOME" *toppath*) )) (define (set-item-env-vars itemdat) (for-each (lambda (item) (debug:print 2 "setenv " (car item) " " (cadr item)) (setenv (car item) (cadr item))) |
︙ | ︙ | |||
185 186 187 188 189 190 191 | (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))) | | | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | (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 inkeys: keys) ;; these may be needed by the launching process (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keys keyvals "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) |
︙ | ︙ | |||
371 372 373 374 375 376 377 | ) ;; setting itemdat to a list if it is #f (if (not itemdat)(set! itemdat '())) (set! item-path (item-list->path itemdat)) (debug:print 2 "Attempting to launch test " test-name (if (equal? item-path "/") "/" item-path)) (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_RUNNAME" runname) | | | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | ) ;; setting itemdat to a list if it is #f (if (not itemdat)(set! itemdat '())) (set! item-path (item-list->path itemdat)) (debug:print 2 "Attempting to launch test " test-name (if (equal? item-path "/") "/" item-path)) (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_RUNNAME" runname) (set-megatest-env-vars run-id inrunname: runname) ;; these may be needed by the launching process (change-directory *toppath*) ;; Here is where the test_meta table is best updated ;; Yes, another use of a global for caching. Need a better way? (if (not (hash-table-ref/default *test-meta-updated* test-name #f)) (begin (hash-table-set! *test-meta-updated* test-name #t) |
︙ | ︙ |