@@ -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 '()) @@ -860,11 +860,11 @@ (launch:setup-for-run 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 +882,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 +1019,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 +1350,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 +1508,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 +1614,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 +1662,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 +1767,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 +1798,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 +1827,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 +1840,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 +1857,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 +1888,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)))