Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -102,23 +102,23 @@ "unknown" (caar uname-res)))) (define (save-environment-as-files fname) (let ((envvars (get-environment-variables)) - (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%]"))) + (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]"))) (with-output-to-file (conc fname ".csh") (lambda () (for-each (lambda (key) (let* ((val (cdr key)) - (sval (if (string-search whitesp val)(conc "'" val "'") val))) + (sval (if (string-search whitesp val)(conc "\"" val "\"") val))) (print "setenv " (car key) " " sval))) envvars))) (with-output-to-file (conc fname ".sh") (lambda () (for-each (lambda (key) (let* ((val (cdr key)) - (sval (if (string-search whitesp val)(conc "'" val "'") val))) + (sval (if (string-search whitesp val)(conc "\"" val "\"") val))) (print "export " (car key) "=" sval))) envvars))))) ;; set some env vars from an alist, return an alist with original values ;; (("VAR" "value") ...) Index: dashboard-guimonitor.scm ================================================================== --- dashboard-guimonitor.scm +++ dashboard-guimonitor.scm @@ -54,11 +54,11 @@ (map (lambda (var) (iup:hbox (iup:label var #:size "60x15") (iup:textbox #:expand "HORIZONTAL" #:action (lambda (obj a val) (hash-table-set! var-params var val))))) - (list "runname" "testpatts" "itempatts"))))) + (list "runname" "testpatts" "itempatts" "params"))))) (controls (iup:frame #:title "Controls" (iup:hbox (iup:frame #:title "Runs" Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -54,17 +54,31 @@ (ezsteps (assoc/default 'ezsteps cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) (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)) (fullrunscript (if runscript (conc testpath "/" runscript) #f)) (db #f)) (debug:print 2 "Exectuing " test-name " on " (get-host-name)) (change-directory testpath) + ;; 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) + (map (lambda (varpair) + (let ((varval (string-split varpair "="))) + (if (eq? (length varval) 2) + (let ((var (car varval)) + (val (cadr varval))) + (debug:print 1 "Adding pre-var/val " var " = " val " to the environment") + (setenv var val))))) + varpairs))) (setenv "MT_TEST_RUN_DIR" work-area) (setenv "MT_TEST_NAME" test-name) (setenv "MT_ITEM_INFO" (conc itemdat)) (setenv "MT_RUNNAME" runname) (setenv "MT_MEGATEST" megatest) @@ -354,11 +368,11 @@ ;; 3. create link from run dir to megatest runs area ;; 4. remotely run the test on allocated host ;; - could be ssh to host from hosts table (update regularly with load) ;; - could be netbatch ;; (launch-test db (cadr status) test-conf)) -(define (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat) +(define (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat params) (change-directory *toppath*) (let ((useshell (config-lookup *configdat* "jobtools" "useshell")) (launcher (config-lookup *configdat* "jobtools" "launcher")) (runscript (config-lookup test-conf "setup" "runscript")) (ezsteps (> (length (hash-table-ref/default test-conf "ezsteps" '())) 0)) ;; don't send all the steps, could be big @@ -392,23 +406,25 @@ (if diskpath (let ((dat (create-work-area db run-id test-path diskpath test-name itemdat))) (set! work-area (car dat)) (set! toptest-work-area (cadr dat))) (begin - (set! work-area test-path) - (debug:print 0 "WARNING: No disk work area specified - running in the test directory"))) + (set! work-area (conc test-path "/tmp_run")) + (create-directory work-area #t) + (debug:print 0 "WARNING: No disk work area specified - running in the test directory under tmp_run"))) (set! cmdparms (base64:base64-encode (with-output-to-string (lambda () ;; (list 'hosts hosts) (write (list (list 'testpath test-path) (list 'work-area work-area) (list 'test-name test-name) (list 'runscript runscript) (list 'run-id run-id ) (list 'itemdat itemdat ) (list 'megatest remote-megatest) - (list 'ezsteps ezsteps) - (list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '())) + (list 'ezsteps ezsteps) + (list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '())) + (list 'set-vars (if params (hash-table-ref/default params "-setvars" #f))) (list 'runname runname) (list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " ")))) ;; clean out step records from previous run if they exist (db:delete-test-step-records db run-id test-name itemdat) (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -88,11 +88,12 @@ -rebuild-db : bring the database schema up to date -rollup : fill run (set by :runname) with latest test(s) from prior runs with same keys -update-meta : update the tests metadata for all tests -env2file fname : write the environment to fname.csh and fname.sh - + -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are + overwritten by values set in config files. Spreadsheet generation -extract-ods : extract an open document spreadsheet from the database -pathmod path : insert path, i.e. path/runame/itempath/logfile.html will clear the field if no rundir/testname/itempath/logfile if it contains forward slashes the path will be converted @@ -145,10 +146,11 @@ ":units" ;; misc "-extract-ods" "-pathmod" "-env2file" + "-setvars" "-debug" ;; for *verbosity* > 2 ) (list "-h" "-force" "-xterm" Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -709,11 +709,11 @@ (if (not parent-test) (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override")) (let* ((get-prereqs-cmd (lambda () (db-get-prereqs-not-met db run-id waiton))) ;; check before running .... (launch-cmd (lambda () - (launch-test db run-id (args:get-arg ":runname") test-conf keyvallst test-name test-path itemdat))) + (launch-test db run-id (args:get-arg ":runname") test-conf keyvallst test-name test-path itemdat args:arg-hash))) (testrundat (list get-prereqs-cmd launch-cmd))) (if (or (args:get-arg "-force") (let ((preqs-not-yet-met ((car testrundat)))) (debug:print 2 "Preqrequesites for " test-name ": " preqs-not-yet-met) (null? preqs-not-yet-met))) ;; are there any tests that must be run before this one... @@ -1020,11 +1020,11 @@ (if (not parent-test) (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override")) (let* ((get-prereqs-cmd (lambda () (db-get-prereqs-not-met db run-id waiton))) ;; check before running .... (launch-cmd (lambda () - (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat))) + (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat flags))) (testrundat (list get-prereqs-cmd launch-cmd))) (if (or force (let ((preqs-not-yet-met ((car testrundat)))) (debug:print 2 "Preqrequesites for " test-name ": " preqs-not-yet-met) (null? preqs-not-yet-met))) ;; are there any tests that must be run before this one... Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -301,11 +301,11 @@ (tasks:task-get-owner task) flags) (tasks:set-state tdb (tasks:task-get-id task) "waiting"))) (define (tasks:rollup-runs db tdb task) - (let* ((flags (make-hash-table)) + (let* ((flags (make-hash-table)) (keys (db:get-keys db)) (keyvallst (keys:target->keyval keys (tasks:task-get-target task)))) ;; (hash-table-set! flags "-rerun" "NOT_STARTED") (print "Starting rollup " task) ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -29,10 +29,12 @@ # in the testconfig [pre-launch-env-overrides] section [env-override] SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs TESTVAR [system realpath .] DEADVAR [system ls] +VARWITHDOLLAR $HOME/.zshrc + # XTERM [system xterm] # RUNDEAD [system exit 56] ## disks are: ## name host:/path/to/area