Overview
Comment: | Improved cache factors for testconfig |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.55 |
Files: | files | file ages | folders |
SHA1: |
fd11c410eeee0ee984a5e0a08b419763 |
User & Date: | matt on 2013-08-18 16:01:10 |
Other Links: | branch diff | manifest | tags |
Context
2013-08-18
| ||
22:03 | Better support for read-only access to a Megatest area check-in: 439da33084 user: matt tags: v1.55 | |
16:01 | Improved cache factors for testconfig check-in: fd11c410ee user: matt tags: v1.55 | |
14:53 | Tweaks to triggers implementation. Use caching (dangerous but necessary as performance is terrible otherwise) check-in: db9c121e0f user: matt tags: v1.55 | |
Changes
Modified common.scm from [5237757a15] to [6f10718538].
︙ | ︙ | |||
70 71 72 73 74 75 76 | (define *run-info-cache* (make-hash-table)) ;; run info is stable, no need to reget ;; Awful. Please FIXME (define *env-vars-by-run-id* (make-hash-table)) (define *current-run-name* #f) ;; Testconfig and runconfig caches. | | | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | (define *run-info-cache* (make-hash-table)) ;; run info is stable, no need to reget ;; Awful. Please FIXME (define *env-vars-by-run-id* (make-hash-table)) (define *current-run-name* #f) ;; Testconfig and runconfig caches. (define *testconfigs* (make-hash-table)) ;; test-name => testconfig (define *runconfigs* (make-hash-table)) ;; target => runconfig (define (common:clear-caches) (set! *target* (make-hash-table)) (set! *keys* (make-hash-table)) (set! *keyvals* (make-hash-table)) (set! *toptest-paths* (make-hash-table)) (set! *test-paths* (make-hash-table)) |
︙ | ︙ |
Modified launch.scm from [658a0efdee] to [c53205e00d].
︙ | ︙ | |||
176 177 178 179 180 181 182 | (loop (+ i 1))) ))))) ;; then, if runscript ran ok (or did not get called) ;; do all the ezsteps (if any) (if ezsteps (let* ((testconfig (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here? (ezstepslst (hash-table-ref/default testconfig "ezsteps" '()))) | | | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | (loop (+ i 1))) ))))) ;; then, if runscript ran ok (or did not get called) ;; do all the ezsteps (if any) (if ezsteps (let* ((testconfig (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here? (ezstepslst (hash-table-ref/default testconfig "ezsteps" '()))) (hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ... (if (not (file-exists? ".ezsteps"))(create-directory ".ezsteps")) ;; if ezsteps was defined then we are sure to have at least one step but check anyway (if (not (> (length ezstepslst) 0)) (debug:print 0 "ERROR: ezsteps defined but ezstepslst is zero length") (let loop ((ezstep (car ezstepslst)) (tal (cdr ezstepslst)) (prevstep #f)) |
︙ | ︙ |
Modified mt.scm from [ff7cd2e663] to [9f3a7e8a6b].
︙ | ︙ | |||
91 92 93 94 95 96 97 98 99 100 101 102 103 104 | ;;====================================================================== ;; T R I G G E R S ;;====================================================================== (define (mt:process-triggers test-id newstate newstatus) (let* ((test-dat (mt:lazy-get-test-info-by-id test-id)) (test-rundir (db:test-get-rundir test-dat)) (tconfig #f) (state (if newstate newstate (db:test-get-state test-dat))) (status (if newstatus newstatus (db:test-get-status test-dat)))) (if (and (file-exists? test-rundir) (directory? test-rundir)) (begin (push-directory test-rundir) | > | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | ;;====================================================================== ;; T R I G G E R S ;;====================================================================== (define (mt:process-triggers test-id newstate newstatus) (let* ((test-dat (mt:lazy-get-test-info-by-id test-id)) (test-rundir (db:test-get-rundir test-dat)) (test-name (db:test-get-testname test-dat)) (tconfig #f) (state (if newstate newstate (db:test-get-state test-dat))) (status (if newstatus newstatus (db:test-get-status test-dat)))) (if (and (file-exists? test-rundir) (directory? test-rundir)) (begin (push-directory test-rundir) (set! tconfig (mt:lazy-read-test-config test-name)) (pop-directory) (for-each (lambda (trigger) (let ((cmd (configf:lookup tconfig "triggers" trigger)) (logf (conc test-rundir "/last-trigger.log"))) (if cmd (let ((fullcmd (conc "(" cmd " " test-id " " test-rundir " " trigger ") >> " logf " 2>&1"))) (debug:print-info 0 "TRIGGERED on " trigger ", running command " fullcmd) |
︙ | ︙ | |||
149 150 151 152 153 154 155 | (let* ((tdat (hash-table-ref/default *test-info* test-id #f))) (if (and tdat (< (current-seconds)(+ (vector-ref tdat 0) 10))) (vector-ref tdat 1) ;; no need to update *test-info* as that is done in cdb:get-test-info-by-id (cdb:get-test-info-by-id *runremote* test-id)))) | | < < | | | > > > > > > | | | > > > > > | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | (let* ((tdat (hash-table-ref/default *test-info* test-id #f))) (if (and tdat (< (current-seconds)(+ (vector-ref tdat 0) 10))) (vector-ref tdat 1) ;; no need to update *test-info* as that is done in cdb:get-test-info-by-id (cdb:get-test-info-by-id *runremote* test-id)))) (define (mt:lazy-read-test-config test-name) (let ((tconf (hash-table-ref/default *testconfigs* test-name #f))) (if tconf tconf (let ((test-dirs (tests:get-tests-search-path *configdat*))) (let loop ((hed (car test-dirs)) (tal (cdr test-dirs))) (let ((tconfig-file (conc hed "/" test-name "/testconfig"))) (if (and (file-exists? tconfig-file) (file-read-access? tconfig-file)) (let ((newtcfg (read-config tconfig-file #f #f))) ;; NOTE: Does NOT run [system ...] (hash-table-set! *testconfigs* test-name newtcfg) newtcfg) (if (null? tal) (begin (debug:print 0 "ERROR: No readable testconfig found for " test-name) #f) (loop (car tal)(cdr tal)))))))))) |
Modified runs.scm from [e0d9d07905] to [21dd6a2f0c].
︙ | ︙ | |||
1216 1217 1218 1219 1220 1221 1222 | '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9))))) ;; Update test_meta for all tests (define (runs:update-all-test_meta db) (let ((test-names (tests:get-valid-tests))) (for-each (lambda (test-name) | | < < < < | | 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 | '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9))))) ;; Update test_meta for all tests (define (runs:update-all-test_meta db) (let ((test-names (tests:get-valid-tests))) (for-each (lambda (test-name) (let* ((test-conf (mt:lazy-read-test-config test-name))) ;; use the cdb:remote-run instead of passing in db (if test-conf (runs:update-test_meta test-name test-conf)))) test-names))) ;; This could probably be refactored into one complex query ... (define (runs:rollup-run keys runname user keyvals) (debug:print 4 "runs:rollup-run, keys: " keys " :runname " runname " user: " user) (let* ((db #f) (new-run-id (cdb:remote-run db:register-run #f keyvals runname "new" "n/a" user)) |
︙ | ︙ |
Modified tests.scm from [7ecdd42518] to [7cf7299e0f].
︙ | ︙ | |||
486 487 488 489 490 491 492 | ;; (map (lambda (testp) ;; (last (string-split testp "/"))) ;; tests))))) (define (tests:get-testconfig test-name test-registry system-allowed) (let* ((test-path (hash-table-ref/default test-registry test-name (conc *toppath* "/tests/" test-name))) (test-configf (conc test-path "/testconfig")) | | | | | | | > > | 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 | ;; (map (lambda (testp) ;; (last (string-split testp "/"))) ;; tests))))) (define (tests:get-testconfig test-name test-registry system-allowed) (let* ((test-path (hash-table-ref/default test-registry test-name (conc *toppath* "/tests/" test-name))) (test-configf (conc test-path "/testconfig")) (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) (tcfg (if testexists (read-config test-configf #f system-allowed environ-patt: (if system-allowed "pre-launch-env-vars" #f)) #f))) (hash-table-set! *testconfigs* test-name tcfg) tcfg)) ;; sort tests by priority and waiton ;; Move test specific stuff to a test unit FIXME one of these days (define (tests:sort-by-priority-and-waiton test-records) (let ((mungepriority (lambda (priority) (if priority (let ((tmp (any->number priority))) |
︙ | ︙ |