Overview
Comment: | Added -setvar, changed environment settings to use double quote instead of single quote |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
a9efabed1758d5ddb4fbfca9d873a583 |
User & Date: | matt on 2011-10-30 19:43:42 |
Other Links: | manifest | tags |
Context
2011-10-30
| ||
21:48 | Example run for manual execution of tests check-in: a8bb833bf1 user: matt tags: trunk | |
19:43 | Added -setvar, changed environment settings to use double quote instead of single quote check-in: a9efabed17 user: matt tags: trunk | |
2011-10-29
| ||
21:51 | Fixed test of eztest with logpro check-in: bc64078220 user: matt tags: trunk | |
Changes
Modified common.scm from [1ca3176cc8] to [afba6d90ad].
︙ | ︙ | |||
100 101 102 103 104 105 106 | (uname #f)) (if (null? (car uname-res)) "unknown" (caar uname-res)))) (define (save-environment-as-files fname) (let ((envvars (get-environment-variables)) | | | | | 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | (uname #f)) (if (null? (car uname-res)) "unknown" (caar uname-res)))) (define (save-environment-as-files fname) (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))))) ;; set some env vars from an alist, return an alist with original values ;; (("VAR" "value") ...) (define (alist->env-vars lst) (if (list? lst) |
︙ | ︙ |
Modified dashboard-guimonitor.scm from [2fac0110eb] to [575eae8fef].
︙ | ︙ | |||
52 53 54 55 56 57 58 | (apply iup:vbox (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))))) | | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | (apply iup:vbox (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" "params"))))) (controls (iup:frame #:title "Controls" (iup:hbox (iup:frame #:title "Runs" (iup:hbox (iup:button "Start" |
︙ | ︙ |
Modified launch.scm from [c53eb8cfe9] to [d6ce07b497].
︙ | ︙ | |||
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (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)) (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) (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) (if mt-bindir-path (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path))) | > > > > > > > > > > > > > > | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (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) (if mt-bindir-path (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path))) |
︙ | ︙ | |||
352 353 354 355 356 357 358 | ;; 1. look though disks list for disk with most space ;; 2. create run dir on disk, path name is meaningful ;; 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)) | | | 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 | ;; 1. look though disks list for disk with most space ;; 2. create run dir on disk, path name is meaningful ;; 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 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 (diskspace (config-lookup test-conf "requirements" "diskspace")) (memory (config-lookup test-conf "requirements" "memory")) |
︙ | ︙ | |||
390 391 392 393 394 395 396 | ;; set up the run work area for this test (set! diskpath (get-best-disk *configdat*)) (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 | | > | | | > | 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 | ;; set up the run work area for this test (set! diskpath (get-best-disk *configdat*)) (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 (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 '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 (cond ((and launcher hosts) ;; must be using ssh hostname |
︙ | ︙ |
Modified megatest.scm from [751b469169] to [1013e8e76b].
︙ | ︙ | |||
86 87 88 89 90 91 92 | -rerun FAIL,WARN... : re-run if called on a test that previously ran (nullified if -keepgoing is also specified) -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 | | > | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | -rerun FAIL,WARN... : re-run if called on a test that previously ran (nullified if -keepgoing is also specified) -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 to windows style |
︙ | ︙ | |||
143 144 145 146 147 148 149 150 151 152 153 154 155 156 | ":expected" ":tol" ":units" ;; misc "-extract-ods" "-pathmod" "-env2file" "-debug" ;; for *verbosity* > 2 ) (list "-h" "-force" "-xterm" "-showkeys" "-test-status" | > | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | ":expected" ":tol" ":units" ;; misc "-extract-ods" "-pathmod" "-env2file" "-setvars" "-debug" ;; for *verbosity* > 2 ) (list "-h" "-force" "-xterm" "-showkeys" "-test-status" |
︙ | ︙ |
Modified runs.scm from [a0af6ccbb4] to [631b691194].
︙ | ︙ | |||
707 708 709 710 711 712 713 | (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat)) (if (not runflag) (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 () | | | 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 | (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat)) (if (not runflag) (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 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... (if (not ((cadr testrundat))) ;; this is the line that launches the test to the remote host (begin |
︙ | ︙ | |||
1018 1019 1020 1021 1022 1023 1024 | (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat)) (if (not runflag) (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 () | | | 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 | (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat)) (if (not runflag) (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 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... (if (not ((cadr testrundat))) ;; this is the line that launches the test to the remote host (begin |
︙ | ︙ |
Modified tasks.scm from [8e5c677b38] to [3adb7d7095].
︙ | ︙ | |||
299 300 301 302 303 304 305 | (tasks:task-get-test task) (tasks:task-get-item task) (tasks:task-get-owner task) flags) (tasks:set-state tdb (tasks:task-get-id task) "waiting"))) (define (tasks:rollup-runs db tdb task) | | | 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | (tasks:task-get-test task) (tasks:task-get-item task) (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)) (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 (runs:rollup-run db keys |
︙ | ︙ |
Modified tests/megatest.config from [9392b88636] to [238b002f71].
︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 | # These are set before all tests, override them # 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] # XTERM [system xterm] # RUNDEAD [system exit 56] ## disks are: ## name host:/path/to/area ## -or- ## name /path/to/area | > > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # These are set before all tests, override them # 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 ## -or- ## name /path/to/area |
︙ | ︙ |