Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -60,13 +60,27 @@ (define *toptest-paths* (make-hash-table)) ;; cache toptest path settings here (define *test-paths* (make-hash-table)) ;; cache test-id to test run paths here (define *test-ids* (make-hash-table)) ;; cache run-id, testname, and item-path => test-id (define *test-info* (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db -(define *run-info-cache* (make-hash-table)) ;; run info is stable, no need to reget +(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) - +(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)) + (set! *test-ids* (make-hash-table)) + (set! *test-info* (make-hash-table)) + (set! *run-info-cache* (make-hash-table)) + (set! *env-vars-by-run-id* (make-hash-table)) + (set! *test-id-cache* (make-hash-table))) ;; Debugging stuff (define *verbosity* 1) (define *logging* #f) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -594,10 +594,11 @@ (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id) (debug:print-info 11 "db:set-comment-for-run END run-id: " run-id " comment: " comment)) ;; does not (obviously!) removed dependent data. But why not!!? (define (db:delete-run db run-id) + (common:clear-caches) ;; don't trust caches after doing any deletion (sqlite3:execute db "DELETE FROM runs WHERE id=?;" run-id)) (define (db:update-run-event_time db run-id) (debug:print-info 11 "db:update-run-event_time START run-id: " run-id) (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id) @@ -747,10 +748,11 @@ (sqlite3:execute tdb "DELETE FROM test_data;") (sqlite3:finalize! tdb))))) ;; (define (db:delete-test-records db tdb test-id #!key (force #f)) + (common:clear-caches) (if tdb (begin (sqlite3:execute tdb "DELETE FROM test_steps;") (sqlite3:execute tdb "DELETE FROM test_data;"))) ;; (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)) @@ -761,10 +763,11 @@ (if force (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id) (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a' WHERE id=?;" test-id))))) (define (db:delete-tests-for-run db run-id) + (common:clear-caches) (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id)) (define (db:delete-old-deleted-test-records db) (let ((targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_timealist (open-run-close setup-env-defaults #f "runconfigs.config" #f #f change-env: #f))) + (set! *didsomething* #t))) ;;====================================================================== ;; Remove old run(s) ;;====================================================================== Index: runconfig.scm ================================================================== --- runconfig.scm +++ runconfig.scm @@ -10,45 +10,57 @@ (include "common_records.scm") -(define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)) +(define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)(change-env #t)) (let* ((keys (db:get-keys db)) - (keyvals (db:get-key-vals db run-id)) - (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")) + (keyvals (if run-id (db:get-key-vals db run-id) #f)) + (thekey (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/") + (if (args:get-arg "-reqtarg") + (args:get-arg "-reqtarg") + (if (args:get-arg "-target") + (args:get-arg "-target") + (begin + (debug:print 0 "ERROR: setup-env-defaults called with no run-id or -target or -reqtarg") + "nothing matches this I hope"))))) ;; Why was system disallowed in the reading of the runconfigs file? ;; NOTE: Should be setting env vars based on (target|default) (confdat (read-config fname #f #t environ-patt: environ-patt sections: (list "default" thekey))) (whatfound (make-hash-table)) + (finaldat (make-hash-table)) (sections (list "default" thekey))) (if (not *target*)(set! *target* thekey)) ;; may save a db access or two but repeats db:get-target code (debug:print 4 "Using key=\"" thekey "\"") - (for-each - (lambda (key val) - (setenv (vector-ref key 0) val)) - keys keyvals) - + (if change-env + (for-each + (lambda (key val) + (setenv (vector-ref key 0) val)) + keys keyvals)) + (for-each (lambda (section) (let ((section-dat (hash-table-ref/default confdat section #f))) (if section-dat (for-each (lambda (envvar) + (let ((val (cadr (assoc envvar section-dat)))) (hash-table-set! whatfound section (+ (hash-table-ref/default whatfound section 0) 1)) - (setenv envvar (cadr (assoc envvar section-dat)))) + (if change-env (setenv envvar val)) + (hash-table-set! finaldat envvar val))) (map car section-dat))))) sections) (if already-seen (begin (debug:print 2 "Key settings found in runconfig.config:") (for-each (lambda (fullkey) (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) (debug:print 2 "---") - (set! *already-seen-runconfig-info* #t))))) + (set! *already-seen-runconfig-info* #t))) + finaldat)) (define (set-run-config-vars db run-id) (let ((runconfigf (conc *toppath* "/runconfigs.config")) (targ (or (args:get-arg "-target") (args:get-arg "-reqtarg") Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -67,14 +67,10 @@ (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 ")"))))) -;; Awful. Please FIXME -(define *env-vars-by-run-id* (make-hash-table)) -(define *current-run-name* #f) - (define (db:get-run-key-val db run-id key) (let ((res #f)) (sqlite3:for-each-row (lambda (val) (set! res val)) @@ -200,10 +196,11 @@ ;; 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) + (common:clear-caches) ;; clear all caches (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 @@ -728,10 +725,11 @@ ;; 'set-state-status ;; ;; NB// should pass in keys? ;; (define (runs:operate-on action runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)) + (common:clear-caches) ;; clear all caches (let* ((db #f) (keys (open-run-close db:get-keys db)) (rundat (open-run-close runs:get-runs-by-patt db keys runnamepatt)) (header (vector-ref rundat 0)) (runs (vector-ref rundat 1))