Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -7,11 +7,11 @@ ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== -(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml) +(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml posix-extras) (require-extension sqlite3 regex posix) (require-extension (srfi 18) extras tcp rpc) (import (prefix sqlite3 sqlite3:)) @@ -110,37 +110,42 @@ (let ((match (string-search load-rx l))) (if match (let ((newval (string->number (cadr match)))) (if (number? newval) (set! cpu-load newval)))))) - (car load-res)) + (car load-res)) cpu-load)) (define (get-uname . params) (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params))))) (uname #f)) (if (null? (car uname-res)) "unknown" (caar uname-res)))) -(define (save-environment-as-files fname) +;; filter is a list of vars to not save +;; override is an alist of vars value pairs to override +(define (save-environment-as-files fname #!key (flst '())(overrides '())) (let ((envvars (get-environment-variables)) - (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))) - (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))) - (print "export " (car key) "=" sval))) - envvars))))) + (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]")) + (cshport (open-output-file (conc fname ".csh"))) + (bshport (open-output-file (conc fname ".sh")))) + (for-each (lambda (key) + (let* ((val (cdr key)) + (var (car key)) + (sval (if (assoc var overrides) + (cadr (assoc var overrides)) + (if (string-search whitesp val)(conc "\"" val "\"") val)))) + (if (not (member var flst)) + (begin + (with-output-to-port cshport + (lambda () + (print "setenv " (car key) " " sval))) + (with-output-to-port bshport + (lambda () + (print "export " (car key) "=" sval))))))) + envvars))) ;; set some env vars from an alist, return an alist with original values ;; (("VAR" "value") ...) (define (alist->env-vars lst) (if (list? lst) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -104,11 +104,15 @@ (set-run-config-vars db run-id) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) (set-megatest-env-vars db run-id) (set-item-env-vars itemdat) - (save-environment-as-files "megatest") + (save-environment-as-files "megatest" + flst: '("DISPLAY") + overrides: (if (config-lookup *configdat* "setup" "homedir") + (list (list "HOME" (config-lookup *configdat* "setup" "homedir")) + (list (list "HOME" work-area))))) (test-set-meta-info db run-id test-name itemdat) (test-set-status! db test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f) (if (args:get-arg "-xterm") (set! fullrunscript "xterm") (if (and fullrunscript (not (file-execute-access? fullrunscript))) @@ -354,10 +358,17 @@ (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) (if *toppath* (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated (debug:print 0 "ERROR: failed to find the top path to your run setup.")) + ;; here we extract the path to the megatest executable and append it to the path + (let ((path (pathname-directory (car (argv))))) + (if path + (setenv "PATH" (conc + (get-environment-variable "PATH") + ":" + (posix-extras#resolve-pathname path))))) *toppath*) (define (get-best-disk confdat) (let* ((disks (hash-table-ref/default confdat "disks" #f)) (best #f) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,7 @@ ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.43) +(define megatest-version 1.44) Index: tests/fullrun/config/mt_include_1.config ================================================================== --- tests/fullrun/config/mt_include_1.config +++ tests/fullrun/config/mt_include_1.config @@ -1,9 +1,13 @@ [setup] # exectutable /path/to/megatest max_concurrent_jobs 200 linktree /tmp/mt_links +# homedir overrides the $HOME environment variable. +# if unset $HOME is set to the test run dir ($MT_TEST_RUN_DIR) +# use #{getenv HOME} to use the normal Unix home +# homedir #{getenv HOME} [jobtools] useshell yes # ## launcher launches jobs, the job is managed on the target host ## by megatest, comment out launcher to run local Index: tests/fullrun/tests/all_toplevel/testconfig ================================================================== --- tests/fullrun/tests/all_toplevel/testconfig +++ tests/fullrun/tests/all_toplevel/testconfig @@ -1,8 +1,8 @@ [ezsteps] calcresults megatest -list-runs $MT_RUNNAME -target $MT_TARGET [requirements] -waiton all_toplevel exit_0 exit_1 ez_exit2_fail ez_fail ez_pass ezlog_fail ezlog_fail_then_pass ezlog_pass ezlog_warn lineitem_fail lineitem_pass logpro_required_fail manual_example neverrun priority_1 priority_10 priority_10_waiton_1 priority_2 priority_3 priority_4 priority_5 priority_6 priority_7 priority_8 priority_9 runfirst singletest singletest2 sqlitespeed test_mt_vars +waiton all_toplevel exit_0 exit_1 ez_exit2_fail ez_fail ez_pass ezlog_fail ezlog_fail_then_pass ezlog_pass ezlog_warn lineitem_fail lineitem_pass logpro_required_fail manual_example neverrun priority_1 priority_10 priority_10_waiton_1 priority_2 priority_3 priority_4 priority_5 priority_6 priority_7 priority_8 priority_9 runfirst singletest singletest2 sqlitespeed2 test_mt_vars # This is a "toplevel" test, it does not require waitons to be non-FAIL to run mode toplevel Index: tests/fullrun/tests/test_mt_vars/currentisblah.sh ================================================================== --- tests/fullrun/tests/test_mt_vars/currentisblah.sh +++ tests/fullrun/tests/test_mt_vars/currentisblah.sh @@ -1,3 +1,5 @@ #!/usr/bin/env bash - +set -x +set -f +pwd grep CURRENT megatest.sh | grep /tmp/nada Index: tests/fullrun/tests/test_mt_vars/testconfig ================================================================== --- tests/fullrun/tests/test_mt_vars/testconfig +++ tests/fullrun/tests/test_mt_vars/testconfig @@ -1,10 +1,13 @@ [setup] [ezsteps] lookittmp ls /tmp -lookithome ls /home +lookithome ls $HOME + +testsimple sh -c "exit 0" + # $CURRENT should be /tmp/nada currentisblah currentisblah.sh # $BOGOUS should NOT be set bogousnotset bogousnotset.sh