Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -56,11 +56,11 @@ (argv) (list "-rows" "-run" "-test" "-debug" - "-server" + "-host" ) (list "-h" "-guimonitor" "-main" "-v" @@ -79,33 +79,35 @@ (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* #f) ;; (open-db)) -(if (args:get-arg "-server") +(if (args:get-arg "-host") (begin - (set! *runremote* (string-split (args:get-arg "-server" ":"))) - (server:client-launch))) + (set! *runremote* (string-split (args:get-arg "-host" ":"))) + (server:client-launch)) + (server:client-launch)) ;; HACK ALERT: this is a hack, please fix. (define *read-only* (not (file-read-access? (conc *toppath* "/megatest.db")))) ;; (server:client-setup *db*) (define toplevel #f) (define dlg #f) (define max-test-num 0) -(define *keys* (open-run-close db:get-keys #f)) +;; (define *keys* (open-run-close db:get-keys #f)) +(define *keys* (cdb:remote-run db:get-keys #f)) ;; (define *keys* (db:get-keys *db*)) (define *dbkeys* (map (lambda (x)(vector-ref x 0)) (append *keys* (list (vector "runname" "blah"))))) (define *header* #f) (define *allruns* '()) (define *buttondat* (make-hash-table)) ;; (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 8) -(define *tot-run-count* (open-run-close db:get-num-runs #f "%")) +(define *tot-run-count* (cdb:remote-run db:get-num-runs #f "%")) ;; (define *tot-run-count* (db:get-num-runs *db* "%")) (define *last-update* (current-seconds)) (define *num-tests* 15) (define *start-run-offset* 0) (define *start-test-offset* 0) @@ -169,11 +171,11 @@ (begin (debug:print-info 4 "update-rundat runnamepatt: " runnamepatt " numruns: " numruns " testnamepatt: " testnamepatt " keypatts: " keypatts) (set! *please-update-buttons* #t) (set! *last-db-update-time* modtime) (set! *delayed-update* (- *delayed-update* 1)) - (let* ((allruns (open-run-close db:get-runs #f runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2)) + (let* ((allruns (cdb:remote-run db:get-runs #f runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2)) *start-run-offset* keypatts)) (header (db:get-header allruns)) (runs (db:get-rows allruns)) (result '()) (maxtests 0) @@ -185,13 +187,13 @@ (begin (set! *last-update* (current-seconds)) (set! *tot-run-count* (length runs)))) ;; (rdb:get-num-runs *db* runnamepatt)))) (for-each (lambda (run) (let* ((run-id (db:get-value-by-header run header "id")) - (tests (let ((tsts (open-run-close db:get-tests-for-run #f run-id testnamepatt states statuses))) + (tests (let ((tsts (cdb:remote-run db:get-tests-for-run #f run-id testnamepatt states statuses))) (if *tests-sort-reverse* (reverse tsts) tsts))) - (key-vals (open-run-close db:get-key-vals #f run-id))) + (key-vals (cdb:remote-run db:get-key-vals #f run-id))) (if (> (length tests) maxtests) (set! maxtests (length tests))) (if (or (not *hide-empty-runs*) ;; this reduces the data burden when set (not (null? tests))) (set! result (cons (vector run tests key-vals) result))))) @@ -643,11 +645,11 @@ (if runid (begin (lambda (x) (on-exit (lambda () (if *db* (sqlite3:finalize! *db*)))) - (open-run-close examine-run *db* runid))) + (cdb:remote-run examine-run *db* runid))) (begin (print "ERROR: runid is not a number " (args:get-arg "-run")) (exit 1))))) ((args:get-arg "-test") (let ((testid (string->number (args:get-arg "-test")))) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -69,10 +69,12 @@ (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)) + (keys #f) + (keyvals #f) (fullrunscript (if (not runscript) #f (if (substring-index "/" runscript) runscript ;; use unadultered if contains slashes (let ((fulln (conc testpath "/" runscript))) @@ -83,10 +85,12 @@ (rollup-status 0)) (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) ;; Setup the *runremote* global var (if *runremote* (debug:print 2 "ERROR: I'm not expecting *runremote* to be set at this time")) (set! *runremote* runremote) + (set! keys (cdb:remote-run db:get-keys #f)) + (set! keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f)) ;; 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 ","))) (debug:print 4 "varpairs: " varpairs) @@ -117,11 +121,11 @@ (change-directory *toppath*) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (change-directory work-area) - (open-run-close set-run-config-vars #f run-id) + (open-run-close set-run-config-vars #f run-id keys keyvals) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) (set-megatest-env-vars run-id) (set-item-env-vars itemdat) (save-environment-as-files "megatest") Index: runconfig.scm ================================================================== --- runconfig.scm +++ runconfig.scm @@ -10,13 +10,14 @@ (include "common_records.scm") -(define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)(change-env #t)) - (let* ((keys (db:get-keys db)) - (keyvals (if run-id (db:get-key-vals db run-id) #f)) +;; (define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)(change-env #t)) +(define (setup-env-defaults fname run-id already-seen keys keyvals #!key (environ-patt #f)(change-env #t)) + (let* (;; (keys (db:get-keys db)) + ;; (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") @@ -58,17 +59,18 @@ sections) (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))) finaldat)) -(define (set-run-config-vars db run-id) +(define (set-run-config-vars db run-id keys keyvals) (let ((runconfigf (conc *toppath* "/runconfigs.config")) (targ (or (args:get-arg "-target") (args:get-arg "-reqtarg") (db:get-target db run-id)))) (if (file-exists? runconfigf) - (setup-env-defaults db runconfigf run-id #t environ-patt: (conc "(default" - (if targ - (conc "|" targ ")") - ")"))) + (setup-env-defaults runconfigf run-id #t keys keyvals + environ-patt: (conc "(default" + (if targ + (conc "|" targ ")") + ")"))) (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -215,10 +215,11 @@ (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))) + (keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f)) (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 '()) @@ -225,11 +226,11 @@ (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") + (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)