Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -43,14 +43,18 @@ (define home (getenv "HOME")) (define user (getenv "USER")) ;; GLOBAL GLETCHES (define *db-keys* #f) -(define *configinfo* #f) -(define *configdat* #f) -(define *toppath* #f) + +(define *configinfo* #f) ;; raw results from setup, includes toppath and table from megatest.config +(define *runconfigdat* #f) ;; run configs data +(define *configdat* #f) ;; megatest.config data +(define *configstatus* #f) ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done +(define *toppath* #f) (define *already-seen-runconfig-info* #f) + (define *waiting-queue* (make-hash-table)) (define *test-meta-updated* (make-hash-table)) (define *globalexitstatus* 0) ;; attempt to work around possible thread issues (define *passnum* 0) ;; when running track calls to run-tests or similar (define *write-frequency* (make-hash-table)) ;; run-id => (vector (current-seconds) 0)) @@ -447,17 +451,24 @@ rtestpatt) args-testpatt))) (if rtestpatt (debug:print-info 0 "TESTPATT from runconfigs: " rtestpatt)) testpatt)) +(define (common:get-linktree) + (or (getenv "MT_LINKTREE") + (if *configdat* + (configf:lookup *configdat* "setup" "linktree")))) + (define (common:args-get-runname) - (or (args:get-arg "-runname") - (args:get-arg ":runname") - (getenv "MT_RUNNAME"))) + (let ((res (or (args:get-arg "-runname") + (args:get-arg ":runname") + (getenv "MT_RUNNAME")))) + ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ... + res)) (define (common:args-get-target #!key (split #f)) - (let* ((keys (keys:config-get-fields *configdat*)) + (let* ((keys (if *configdat* (keys:config-get-fields *configdat*) '())) (numkeys (length keys)) (target (if (args:get-arg "-reqtarg") (args:get-arg "-reqtarg") (if (args:get-arg "-target") (args:get-arg "-target") Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -81,11 +81,11 @@ (if (args:get-arg "-h") (begin (print help) (exit))) -(if (not (launch:setup-for-run)) +(if (not (launch:setup)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *useserver* (cond Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -728,11 +728,11 @@ ;; 'closeall - close all opened dbs ;; ;; run-ids: '(1 2 3 ...) or #f (for all) ;; (define (db:multi-db-sync run-ids . options) - (let* ((toppath (launch:setup-for-run)) + (let* ((toppath (launch:setup)) (dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f)) (mtdb (if toppath (db:open-megatest-db))) (allow-cleanup (if run-ids #f #t)) (run-ids (if run-ids run-ids Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -284,11 +284,11 @@ (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) (set! keys (rmt:get-keys)) ;; (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) ;; these may be needed by the launching process ;; one of these is defunct/redundant ... - (if (not (launch:setup-for-run force: #t)) + (if (not (launch:setup force: #t)) (begin (debug:print 0 "Failed to setup, exiting") ;; (sqlite3:finalize! db) ;; (sqlite3:finalize! tdb) (exit 1))) @@ -438,21 +438,21 @@ #f))) (if testconfig (hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ... (begin ;; got here but there are race condiitions - re-do all setup and try one more time - (if (launch:setup-for-run) + (if (launch:setup) (begin (launch:cache-config) (set! testconfig (full-runconfigs-read))) ;; redunantly redundant, but does it resolve the race? (debug:print 0 "WARNING: no testconfig found for " test-name " in search path:\n " (string-intersperse (tests:get-tests-search-path *configdat*) "\n "))))) ;; after all that, still no testconfig? Time to abort (if (not testconfig) (begin (debug:print 0 "ERROR: Failed to resolve megatest.config, runconfigs.config and testconfig issues. Giving up now") - (exit 1)))s + (exit 1))) (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)) @@ -596,130 +596,125 @@ (debug:print 2 "Output from running " fullrunscript ", pid " (launch:einf-pid exit-info) " in work area " work-area ":\n====\n exit code " (launch:einf-exit-code exit-info) "\n" "====\n") (if (not (launch:einf-exit-status exit-info)) (exit 4))))))) -;; set up the very basics needed for doing anything here. -(define (launch:setup-for-run #!key (force #f)) - ;; would set values for KEYS in the environment here for better support of env-override but - ;; have chicken/egg scenario. need to read megatest.config then read it again. Going to - ;; pass on that idea for now - ;; special case - (if (or force (not (hash-table? *configdat*))) ;; no need to re-open on every call - (begin - (set! *configinfo* (or (if (get-environment-variable "MT_CMDINFO") ;; we are inside a test - do not reprocess configs - (let ((alistconfig (conc (get-environment-variable "MT_LINKTREE") "/" - (get-environment-variable "MT_TARGET") "/" - (get-environment-variable "MT_RUNNAME") "/" - ".megatest.cfg-" megatest-version "-" megatest-fossil-hash))) - (if (file-exists? alistconfig) - (list (configf:read-alist alistconfig) - (get-environment-variable "MT_RUN_AREA_HOME")) - #f)) - #f) ;; no config cached - give up - (let ((runname (or (args:get-arg "-runname")(args:get-arg ":runname")))) - (if runname (setenv "MT_RUNNAME" runname)) - (find-and-read-config - (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") - environ-patt: "env-override" - given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") - pathenvvar: "MT_RUN_AREA_HOME")))) - (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) - (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) - (let* ((tmptransport (configf:lookup *configdat* "server" "transport")) - (transport (if tmptransport (string->symbol tmptransport) 'http))) - (if (member transport '(http rpc nmsg)) - (set! *transport-type* transport) - (begin - (debug:print 0 "ERROR: Unrecognised transport " transport) - (exit)))) - (let ((linktree (configf:lookup *configdat* "setup" "linktree"))) ;; link tree is critical - (if linktree - (if (not (file-exists? linktree)) - (begin - (handle-exceptions - exn - (begin - (debug:print 0 "ERROR: Something went wrong when trying to create linktree dir at " linktree) - (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)) - (exit 1)) - (create-directory linktree #t)))) - (begin - (debug:print 0 "ERROR: linktree not defined in [setup] section of megatest.config") - (exit 1))) - (if linktree - (let ((dbdir (conc linktree "/.db"))) - (handle-exceptions - exn - (begin - (debug:print 0 "ERROR: failed to create the " dbdir " area for your database files") - (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))) - (if (not (directory-exists? dbdir))(create-directory dbdir))) - (setenv "MT_LINKTREE" linktree)) - (begin - (debug:print 0 "ERROR: linktree is required in your megatest.config [setup] section") - (exit 1))) - (if (and *toppath* - (directory-exists? *toppath*)) - (setenv "MT_RUN_AREA_HOME" *toppath*) - (begin - (debug:print 0 "ERROR: failed to find the top path to your Megatest area.") - (exit 1))) - ))) - *toppath*) - -(define (launch:cache-config) - ;; if we have a linktree and -runtests and -target and the directory exists dump the config - ;; to megatest-(current-seconds).cfg and symlink it to megatest.cfg - (if (and *configdat* - (or (args:get-arg "-run") - (args:get-arg "-runtests") - (args:get-arg "-execute"))) - (let* ((linktree (get-environment-variable "MT_LINKTREE")) - (target (common:args-get-target)) - (runname (or (args:get-arg "-runname") - (args:get-arg ":runname") - (getenv "MT_RUNNAME"))) - (fulldir (conc linktree "/" - target "/" - runname))) - (debug:print-info 0 "Have -runtests with target=" target ", runname=" runname ", fulldir=" fulldir ", testpatt=" (or (args:get-arg "-testpatt") "%")) - (if (file-exists? linktree) ;; can't proceed without linktree - (begin - (if (not (file-exists? fulldir)) - (create-directory fulldir #t)) ;; need to protect with exception handler - (if (and target - runname - (file-exists? fulldir)) - (let ((tmpfile (conc fulldir "/.megatest.cfg." (current-seconds))) - (targfile (conc fulldir "/.megatest.cfg-" megatest-version "-" megatest-fossil-hash)) - (rconfig (conc fulldir "/.runconfig." megatest-version "-" megatest-fossil-hash))) - (if (file-exists? rconfig) ;; only cache megatest.config AFTER runconfigs has been cached - (begin - (debug:print-info 0 "Caching megatest.config in " fulldir "/.megatest.cfg") - (configf:write-alist *configdat* tmpfile) - (system (conc "ln -sf " tmpfile " " targfile)))) - ))))))) - ;; gather available information, if legit read configs in this order: ;; ;; if have cache; ;; read it a return it ;; else ;; megatest.config (do not cache) ;; runconfigs.config (cache if all vars avail) ;; megatest.config (cache if all vars avail) +;; returns: +;; *toppath* +;; side effects: +;; sets; *configdat* (megatest.config info) +;; *runconfigdat* (runconfigs.config info) +;; *configstatus* (status of the read data) ;; (define (launch:setup #!key (force #f)) (let* ((runname (common:args-get-runname)) (target (common:args-get-target)) - (linktree (or (getenv "MT_LINKTREE") - (if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))) + (linktree (common:get-linktree)) (rundir (if (and runname target linktree)(conc linktree "/" target "/" runname) #f)) (mtcachef (and rundir (conc rundir "/" ".megatest.cfg-" megatest-version "-" megatest-fossil-hash))) - (rccachef (and rundir (conc rundir "/" ".runconfigs.cfg-" megatest-version "-" megatest-fossil-hash)))) - #f)) + (rccachef (and rundir (conc rundir "/" ".runconfigs.cfg-" megatest-version "-" megatest-fossil-hash))) + (cancreate (and rundir (file-exists? rundir)(file-write-access? rundir)))) + (print "runname: " runname " target: " target " mtcachef: " mtcachef " rccachef: " rccachef) + (cond + ;; data was read and cached and available in *configstatus* + ((eq? *configstatus* 'fulldata) + *toppath*) + ;; if mtcachef exists just read it + ((and mtcachef (file-exists? mtcachef)) + (set! *configdat* (configf:read-alist mtcachef)) + (set! *runconfigdat* (configf:read-alist rccachef)) + (set! *configinfo* (list *configdat* (get-environment-variable "MT_RUN_AREA_HOME"))) + (set! *configstatus* 'fulldata) + *toppath*) + ;; we have all the info needed to fully process runconfigs and megatest.config + (mtcachef + (let ((first-pass (find-and-read-config + (or (args:get-arg "-config") "megatest.config") + environ-patt: "env-override" + given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") + pathenvvar: "MT_RUN_AREA_HOME"))) + (if first-pass + (begin + (set! *configdat* (car first-pass)) + (set! *configinfo* first-pass) + (set! *toppath* (cadr first-pass)) + ;; the seed read is done, now read runconfigs, cache it then read megatest.config one more time and cache it + (let* ((keys (rmt:get-keys)) + (key-vals (if target (keys:target->keyval keys target) #f)) + (sections (if target (list "default" target) #f)) ;; for runconfigs + (linktree (or (getenv "MT_LINKTREE") + (if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))) + (runconfigdat (begin + (setenv "MT_RUN_AREA_HOME" *toppath*) + (if key-vals + (for-each (lambda (kt) + (setenv (car kt) (cadr kt))) + key-vals)) + (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections)))) + (if cancreate (configf:write-alist runconfigdat rccachef)) + (set! *runconfigdat* runconfigdat) + (let ((second-pass (find-and-read-config + (or (args:get-arg "-config") "megatest.config") + environ-patt: "env-override" + given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") + pathenvvar: "MT_RUN_AREA_HOME"))) + (if cancreate (configf:write-alist (car second-pass) mtcachef)) + (set! *configdat* (car second-pass)) + (set! *toppath* (cadr second-pass)) + (if cancreate (set! *configstatus* 'fulldata))))) + ;; no configs found? should not happen but let's try to recover gracefully, return an empty hash-table + (set! *configdat* (make-hash-table)) + ))) + ;; else read what you can and set the flag accordingly + (else + (let* ((cfgdat (find-and-read-config + (or (args:get-arg "-config") "megatest.config") + environ-patt: "env-override" + given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") + pathenvvar: "MT_RUN_AREA_HOME")) + (sections (if target (list "default" target) #f)) + (rdat (read-config (conc (or *toppath* (get-environment-variable "MT_RUN_AREA_HOME")(cadr cfgdat)) + "/runconfigs.config") #f #t sections: sections))) + (set! *configinfo* cfgdat) + (set! *configdat* (car cfgdat)) + (set! *runconfigdat* rdat) + (set! *toppath* (cadr cfgdat)) + (set! *configstatus* 'partial)))) + ;; final house keeping + (let* ((keys (rmt:get-keys)) + (key-vals (if target (keys:target->keyval keys target) #f)) + (sections (if target (list "default" target) #f)) ;; for runconfigs + (linktree (or (getenv "MT_LINKTREE") + (if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))) + (if linktree + (if (not (file-exists? linktree)) + (begin + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Something went wrong when trying to create linktree dir at " linktree) + (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)) + (exit 1)) + (create-directory linktree #t)))) + (begin + (debug:print 0 "ERROR: linktree not defined in [setup] section of megatest.config") + ;; (exit 1) + ))) + (if (and *toppath* + (directory-exists? *toppath*)) + (setenv "MT_RUN_AREA_HOME" *toppath*) + (begin + (debug:print 0 "ERROR: failed to find the top path to your Megatest area."))) + *toppath*)) (define (get-best-disk confdat testconfig) (let* ((disks (or (and testconfig (hash-table-ref/default testconfig "disks" #f)) (hash-table-ref/default confdat "disks" #f))) (minspace (let ((m (configf:lookup confdat "setup" "minspace"))) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -468,11 +468,11 @@ (begin (save-environment-as-files (args:get-arg "-env2file")) (set! *didsomething* #t))) (if (args:get-arg "-list-disks") - (let ((toppath (launch:setup-for-run))) + (let ((toppath (launch:setup))) (print (string-intersperse (map (lambda (x) (string-intersperse x @@ -720,11 +720,11 @@ (if (args:get-arg "-server") ;; Server? Start up here. ;; - (let ((tl (launch:setup-for-run)) + (let ((tl (launch:setup)) (run-id (and (args:get-arg "-run-id") (string->number (args:get-arg "-run-id"))))) (if run-id (begin (server:launch run-id) @@ -740,11 +740,11 @@ '("-list-servers" "-stop-server" "-show-cmdinfo" "-list-runs" "-ping"))) - (if (launch:setup-for-run) + (if (launch:setup) (let ((run-id (and (args:get-arg "-run-id") (string->number (args:get-arg "-run-id"))))) ;; (set! *fdb* (filedb:open-db (conc *toppath* "/db/paths.db"))) ;; if not list or kill then start a client (if appropriate) (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test") @@ -760,11 +760,11 @@ ;; MAY STILL NEED THIS ;; (set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t)))))))))) (if (or (args:get-arg "-list-servers") (args:get-arg "-stop-server")) - (let ((tl (launch:setup-for-run))) + (let ((tl (launch:setup))) (if tl (let* ((tdbdat (tasks:open-db)) (servers (tasks:get-all-servers (db:delay-if-busy tdbdat))) (fmtstr "~5a~12a~8a~20a~24a~10a~10a~10a~10a\n") (servers-to-kill '()) @@ -827,44 +827,50 @@ (json-write targets)) (else (debug:print 0 "ERROR: dump output format " (args:get-arg "-dumpmode") " not supported for -list-targets"))) (set! *didsomething* #t))) -;; cache the runconfigs in $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME/.runconfig +;; get the runconfigs ;; (define (full-runconfigs-read) - (let* ((rundir (if (and (getenv "MT_LINKTREE")(getenv "MT_TARGET")(getenv "MT_RUNNAME")) - (conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME")) - #f)) - (cfgf (if rundir (conc rundir "/.runconfig." megatest-version "-" megatest-fossil-hash) #f))) - (if (and cfgf - (file-exists? cfgf) - (file-write-access? cfgf)) - (configf:read-alist cfgf) - (let* ((keys (rmt:get-keys)) - (target (common:args-get-target)) - (key-vals (if target (keys:target->keyval keys target) #f)) - (sections (if target (list "default" target) #f)) - (data (begin - (setenv "MT_RUN_AREA_HOME" *toppath*) - (if key-vals - (for-each (lambda (kt) - (setenv (car kt) (cadr kt))) - key-vals)) - (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections)))) - (if (and rundir ;; have all needed variabless - (directory-exists? rundir) - (file-write-access? rundir)) - (begin - (configf:write-alist data cfgf) - ;; force re-read of megatest.config - this resolves circular references between megatest.config - (launch:setup-for-run force: #t) - (launch:cache-config))) ;; we can safely cache megatest.config since we have a valid runconfig - data)))) + (if (eq? *configstatus* 'fulldata) + *runconfigdat* + (begin + (launch:setup) + *runconfigdat*))) + +;; (let* ((rundir (if (and (getenv "MT_LINKTREE")(getenv "MT_TARGET")(getenv "MT_RUNNAME")) +;; (conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME")) +;; #f)) +;; (cfgf (if rundir (conc rundir "/.runconfig." megatest-version "-" megatest-fossil-hash) #f))) +;; (if (and cfgf +;; (file-exists? cfgf) +;; (file-write-access? cfgf)) +;; (configf:read-alist cfgf) +;; (let* ((keys (rmt:get-keys)) +;; (target (common:args-get-target)) +;; (key-vals (if target (keys:target->keyval keys target) #f)) +;; (sections (if target (list "default" target) #f)) +;; (data (begin +;; (setenv "MT_RUN_AREA_HOME" *toppath*) +;; (if key-vals +;; (for-each (lambda (kt) +;; (setenv (car kt) (cadr kt))) +;; key-vals)) +;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections)))) +;; (if (and rundir ;; have all needed variabless +;; (directory-exists? rundir) +;; (file-write-access? rundir)) +;; (begin +;; (configf:write-alist data cfgf) +;; ;; force re-read of megatest.config - this resolves circular references between megatest.config +;; (launch:setup force: #t) +;; (launch:cache-config))) ;; we can safely cache megatest.config since we have a valid runconfig +;; data)))) (if (args:get-arg "-show-runconfig") - (let ((tl (launch:setup-for-run))) + (let ((tl (launch:setup))) (push-directory *toppath*) (let ((data (full-runconfigs-read))) ;; keep this one local (cond ((and (args:get-arg "-section") @@ -882,11 +888,11 @@ (debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised"))) (set! *didsomething* #t)) (pop-directory))) (if (args:get-arg "-show-config") - (let ((tl (launch:setup-for-run)) + (let ((tl (launch:setup)) (data *configdat*)) ;; (read-config "megatest.config" #f #t))) (push-directory *toppath*) ;; keep this one local (cond ((and (args:get-arg "-section") @@ -1019,11 +1025,11 @@ ;; ;; IDEA: megatest list -runname blah% ... ;; (if (or (args:get-arg "-list-runs") (args:get-arg "-list-db-targets")) - (if (launch:setup-for-run) + (if (launch:setup) (let* (;; (dbstruct (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local"))) (runpatt (args:get-arg "-list-runs")) (testpatt (common:args-get-testpatt #f)) ;; (if (args:get-arg "-testpatt") ;; (args:get-arg "-testpatt") @@ -1350,11 +1356,11 @@ (set! *didsomething* #t)))) ;; Don't think I need this. Incorporated into -list-runs instead ;; ;; (if (and (args:get-arg "-since") -;; (launch:setup-for-run)) +;; (launch:setup)) ;; (let* ((since-time (string->number (args:get-arg "-since"))) ;; (run-ids (db:get-changed-run-ids since-time))) ;; ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) ;; (print (sort run-ids <)) ;; (set! *didsomething* #t))) @@ -1508,11 +1514,11 @@ (change-directory toppath) (if (not target) (begin (debug:print 0 "ERROR: -target is required.") (exit 1))) - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, giving up on -test-paths or -test-files, exiting") (exit 1))) (let* ((keys (rmt:get-keys)) ;; db:test-get-paths must not be run remote @@ -1614,11 +1620,11 @@ (test-id (assoc/default 'test-id cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) (db #f)) (change-directory testpath) - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (if (and state status) (rmt:teststep-set-status! run-id test-id step state status msg logfile) @@ -1662,11 +1668,11 @@ (itemdat (assoc/default 'itemdat cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) (db #f) ;; (open-db)) (state (args:get-arg ":state")) (status (args:get-arg ":status"))) - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (if (args:get-arg "-runstep")(debug:print-info 1 "Running -runstep, first change to directory " work-area)) @@ -1767,11 +1773,11 @@ (if (or (args:get-arg "-showkeys") (args:get-arg "-show-keys")) (let ((db #f) (keys #f)) - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (set! keys (rmt:get-keys)) ;; db)) (debug:print 1 "Keys: " (string-intersperse keys ", ")) @@ -1798,21 +1804,21 @@ ;; Update the database schema, clean up the db ;;====================================================================== (if (args:get-arg "-rebuild-db") (begin - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; keep this one local (open-run-close patch-db #f) (set! *didsomething* #t))) (if (args:get-arg "-cleanup-db") (begin - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; keep this one local ;; (open-run-close db:clean-up #f) @@ -1827,11 +1833,11 @@ ) (set! *didsomething* #t))) (if (args:get-arg "-mark-incompletes") (begin - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") b (exit 1))) (open-run-close db:find-and-mark-incomplete #f) (set! *didsomething* #t))) @@ -1840,11 +1846,11 @@ ;; Update the tests meta data from the testconfig files ;;====================================================================== (if (args:get-arg "-update-meta") (begin - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; now can find our db ;; keep this one local @@ -1857,11 +1863,11 @@ ;; fakeout readline (if (or (args:get-arg "-repl") (args:get-arg "-load")) - (let* ((toppath (launch:setup-for-run)) + (let* ((toppath (launch:setup)) (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f))) (if dbstruct (begin (set! *db* dbstruct) (set! *client-non-blocking-mode* #t) @@ -1888,11 +1894,11 @@ (if (and (args:get-arg "-run-wait") (not (or (args:get-arg "-run") (args:get-arg "-runtests")))) ;; run-wait is built into runtests now (begin - (if (not (launch:setup-for-run)) + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (operate-on 'run-wait) (set! *didsomething* #t))) Index: newdashboard.scm ================================================================== --- newdashboard.scm +++ newdashboard.scm @@ -67,11 +67,11 @@ (if (args:get-arg "-h") (begin (print help) (exit))) -(if (not (launch:setup-for-run)) +(if (not (launch:setup)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) ;; (if (args:get-arg "-host") Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -40,11 +40,11 @@ ;; NOT YET UTILIZED ;; (define (runs:create-run-record) (let* ((mconfig (if *configdat* *configdat* - (if (launch:setup-for-run) + (if (launch:setup) *configdat* (begin (debug:print 0 "ERROR: Called setup in a non-megatest area, exiting") (exit 1))))) (runrec (runs:runrec-make-record)) @@ -1780,14 +1780,11 @@ (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with -runname runname") (exit 3)) (else (let (;; (db #f) (keys #f)) - (if (launch:setup-for-run) - (begin - (full-runconfigs-read) ;; cache the run config - (launch:cache-config)) ;; do not cache here - need to be sure runconfigs is processed + (if (not (launch:setup)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (set! keys (keys:config-get-fields *configdat*)) ;; have enough to process -target or -reqtarg here Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -207,11 +207,11 @@ (let ((tdbdat (tasks:open-db))) (let* ((host-port (let ((slst (string-split host:port ":"))) (if (eq? (length slst) 2) (list (car slst)(string->number (cadr slst))) #f))) - (toppath (launch:setup-for-run)) + (toppath (launch:setup)) (server-db-dat (if (not host-port)(tasks:get-server (db:delay-if-busy tdbdat) run-id) #f))) (if (not run-id) (begin (debug:print 0 "ERROR: must specify run-id when doing ping, -run-id n") (print "ERROR: No run-id")