Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -1748,10 +1748,12 @@ key "=" delim (mungeval val) delim))) envvars))))) ;; set some env vars from an alist, return an alist with original values ;; (("VAR" "value") ...) +;; a value of #f means "unset this var" +;; (define (alist->env-vars lst) (if (list? lst) (let ((res '())) (for-each (lambda (p) (let* ((var (car p)) Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -457,10 +457,15 @@ '() (map car sectdat)))) (define (configf:get-section cfgdat section) (hash-table-ref/default cfgdat section '())) + +(define (configf:set-section-var cfgdat section var val) + (let ((sectdat (configf:get-section cfgdat section))) + (append (filter (lambda (x)(not (assoc var sectdat))) sectdat) + (list var val)))) (define (setup) (let* ((configf (find-config "megatest.config")) (config (if configf (read-config configf #f #t) #f))) (if config Index: docs/manual/reference.txt ================================================================== --- docs/manual/reference.txt +++ docs/manual/reference.txt @@ -608,11 +608,10 @@ Then in runconfigs.config .Example of using modified.config in a testconfig ------------------------------ cat testconfig - [pre-launch-env-vars] [include modified.config] ------------------------------ Managing Old Runs @@ -628,10 +627,62 @@ --------------------- # use -precmd 'sleep 5;nbfake' to limit overloading the host computer but to allow the removes to run in parallel. megatest -actions print,remove-runs -remove-keep 3 -target %/%/%/% -runname % -age 1w -precmd 'sleep 5;nbfake'" --------------------- +Nested Runs +----------- + +A Megatest test can run a full Megatest run in either the same +Megatest area or in another area. This is a powerful way of chaining +complex suites of tests and or actions. + +If you are not using the current area you can use ezsteps to retrieve +and setup the sub-Megatest run area. + +In the testconfig: +--------------- +[subrun] + +# Required: wait for the run or just launch it +# if no then the run will be an automatic PASS irrespective of the actual result +runwait yes|no + +# Optional: where to execute the run. Default is the current runarea +runarea /some/path/to/megatest/area + +# Optional: method to use to determine pass/fail status of the run +# auto (default) - roll up the net state/status of the sub-run +# logpro - use the provided logpro rules, happens automatically if there is a logpro section +# passfail auto|logpro +# Example of logpro: +passfail logpro + +# Optional: +logpro ;; if this section exists then logpro is used to determine pass/fail + (expect:required in "LogFileBody" >= 1 "At least one pass" #/PASS/) + +# Optional: target translator, default is to use the parent target +target somescript.sh + +# Optional: runname translator/generator, default is to use the parent runname +runname somescript.sh + +# Optional: testpatt spec, default is to first look for TESTPATT spec from runconfigs unless there is a contour spec +testpatt %/item1,test2 + +# Optional: contour spec, use the named contour from the megatest.config contour spec +contour contourname ### NOTE: Not implemented yet! Let us know if you need this feature. + +# Optional: mode-patt, use this spec for testpatt from runconfigs +mode-patt TESTPATT + +# Optional: tag-expr, use this tag-expr to select tests +tag-expr quick + +--------------- + Programming API --------------- These routines can be called from the megatest repl. Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -79,12 +79,20 @@ #f))) (define (launch:runstep ezstep run-id test-id exit-info m tal testconfig) (let* ((stepname (car ezstep)) ;; do stuff to run the step (stepinfo (cadr ezstep)) + ;; (let ((info (cadr ezstep))) + ;; (if (proc? info) "" info))) + ;; (stepproc (let ((info (cadr ezstep))) + ;; (if (proc? info) info #f))) (stepparts (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo)) - (stepparms (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each + (stepparams (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each + (paramparts (if (list? stepparams) + (map (lambda (x)(string-split x "=")) (string-split-fields "[^;]*=[^;]*" stepparams)) + '())) + (subrun (alist-ref "subrun" paramparts equal?)) (stepcmd (list-ref stepparts 3)) (script "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!\ (logpro-file (conc stepname ".logpro")) (html-file (conc stepname ".html")) (dat-file (conc stepname ".dat")) @@ -101,11 +109,11 @@ (print tconfig-logpro))) (set! logpro-used #t))) ;; NB// can safely assume we are in test-area directory (debug:print 4 *default-log-port* "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts - " stepparms: " stepparms " stepcmd: " stepcmd) + " stepparams: " stepparams " stepcmd: " stepcmd) ;; ;; first source the previous environment ;; (let ((prev-env (conc ".ezsteps/" prevstep (if (string-search (regexp "csh") ;; (get-environment-variable "SHELL")) ".csh" ".sh")))) ;; (if (and prevstep (common:file-exists? prev-env)) @@ -119,12 +127,17 @@ ;; now launch the actual process (call-with-environment-variables (list (cons "PATH" (conc (get-environment-variable "PATH") ":."))) (lambda () ;; (process-run "/bin/bash" "-c" "exec ls -l /tmp/foobar > /tmp/delme-more.log 2>&1") (let* ((cmd (conc stepcmd " > " stepname ".log 2>&1")) ;; >outfile 2>&1 - (pid (process-run "/bin/bash" (list "-c" cmd)))) - + (pid #f)) + (let ((proc (lambda () + (set! pid (process-run "/bin/bash" (list "-c" cmd)))))) + (if subrun + (common:without-vars proc "^MT_.*") + (proc))) + (with-output-to-file "Makefile.ezsteps" (lambda () (print stepname ".log :") (print "\t" cmd) (if (common:file-exists? (conc stepname ".logpro")) @@ -240,11 +253,11 @@ (launch:einf-rollup-status-set! exit-info 1) ;; (vector-set! exit-info 3 1) ;; force fail, this used to be next-state but that doesn't make sense. should always be "COMPLETED" (tests:test-set-status! run-id test-id "COMPLETED" "FAIL" (conc "Failed at step " stepname) #f) ))) logpro-used)) -(define (launch:manage-steps run-id test-id item-path fullrunscript ezsteps test-name tconfigreg exit-info m) +(define (launch:manage-steps run-id test-id item-path fullrunscript ezsteps subrun test-name tconfigreg exit-info m) ;; (let-values ;; (((pid exit-status exit-code) ;; (run-n-wait fullrunscript))) ;; (tests:test-set-status! test-id "RUNNING" "n/a" #f #f) ;; Since we should have a clean slate at this time there is no need to do @@ -274,11 +287,11 @@ (thread-sleep! 2) (loop (+ i 1))) ))))) ;; then, if runscript ran ok (or did not get called) ;; do all the ezsteps (if any) - (if ezsteps + (if (or ezsteps subrun) (let* ((testconfig ;; (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here? ;; NOTE: it is tempting to turn off force-create of testconfig but dynamic ;; ezstep names need a full re-eval here. (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t)) ;; 'return-procs))) (ezstepslst (if (hash-table? testconfig) @@ -293,29 +306,85 @@ ;; after all that, still no testconfig? Time to abort (if (not testconfig) (begin (debug:print-error 0 *default-log-port* "Failed to resolve megatest.config, runconfigs.config and testconfig issues. Giving up now") (exit 1))) - (if (not (common: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-error 0 *default-log-port* "ezsteps defined but ezstepslst is zero length") - (let loop ((ezstep (car ezstepslst)) - (tal (cdr ezstepslst)) - (prevstep #f)) - ;; check exit-info (vector-ref exit-info 1) - (if (launch:einf-exit-status exit-info) ;; (vector-ref exit-info 1) - (let ((logpro-used (launch:runstep ezstep run-id test-id exit-info m tal testconfig)) - (stepname (car ezstep))) - ;; if logpro-used read in the stepname.dat file - (if (and logpro-used (common:file-exists? (conc stepname ".dat"))) - (launch:load-logpro-dat run-id test-id stepname)) - (if (steprun-good? logpro-used (launch:einf-exit-code exit-info)) - (if (not (null? tal)) - (loop (car tal) (cdr tal) stepname)) - (debug:print 4 *default-log-port* "WARNING: step " (car ezstep) " failed. Stopping"))) - (debug:print 4 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep))))))) + + ;; create a proc for the subrun if requested, save that proc in the ezsteps table as the last entry + ;; 1. get section [runarun] + ;; 2. unset MT_* vars + ;; 3. fix target + ;; 4. fix runname + ;; 5. fix testpatt or calculate it from contour + ;; 6. launch the run + ;; 7. roll up the run result and or roll up the logpro processed result + (if (configf:lookup testconfig "subrun" "runwait") ;; we use runwait as the flag that a subrun is requested + (let* ((runarea (configf:lookup testconfig "subrun" "runarea")) + (passfail (configf:lookup testconfig "subrun" "passfail")) + (target (configf:lookup testconfig "subrun" "target")) + (runname (configf:lookup testconfig "subrun" "runname")) + (contour (configf:lookup testconfig "subrun" "contour")) + (testpatt (configf:lookup testconfig "subrun" "testpatt")) + (mode-patt (configf:lookup testconfig "subrun" "mode-patt")) + (tag-expr (configf:lookup testconfig "subrun" "tag-expr")) + (run-wait (configf:lookup testconfig "subrun" "runwait")) + (logpro (configf:lookup testconfig "subrun" "logpro")) + (compact-stem (string-substitute "[/*]" "_" (conc target "-" runname "-" (or testpatt mode-patt tag-expr)))) + (log-file (conc compact-stem ".log")) + (mt-cmd (conc "megatest -run -target " target + " -runname " runname + (if runarea (conc " -start-dir " runarea) *toppath*) + (if testpatt (conc " -testpatt " testpatt) "") + (if mode-patt (conc " -modepatt " mode-patt) "") + (if tag-expr (conc " -tag-expr" tag-expr) "") + (if (equal? runwait "yes") " -runwait " "") + " -log " log-file))) + ;; change directory to runarea, create it if needed, we do NOT create the directory + (if runarea + (if (directory-exists? runarea) + (change-directory runarea) + (begin + (debug:print 0 *default-log-port* "ERROR: for sub-megatest run the runarea \"" runarea "\" does not exist! EXITING.") + (exit 1)))) + ;; (let ((subrun (conc *toppath* "/subrun") #t)) + ;; (create-directory subrun) + ;; (change-directory subrun))) + + ;; by this point we are in the right place to run the subrun and we have a Megatest command to run + ;; (filter (lambda (x)(string-match "MT_.*" (car x))) (get-environment-variables)) + (common:without-vars mt-cmd "^MT_.*") + (set! ezsteps (append ezsteps (list "subrun" (conc "{subrun=true} " mt-cmd)))) + (configf:set-section-var testconfig "logpro" "subrun" logpro) ;; append the logpro rules to the logpro section as stepname subrun + )) + + ;; process the ezsteps + (if ezsteps + (begin + (if (not (common: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-error 0 *default-log-port* "ezsteps defined but ezstepslst is zero length") + (let loop ((ezstep (car ezstepslst)) + (tal (cdr ezstepslst)) + (prevstep #f)) + ;; check exit-info (vector-ref exit-info 1) + (if (launch:einf-exit-status exit-info) ;; (vector-ref exit-info 1) + (let ((logpro-used (launch:runstep ezstep run-id test-id exit-info m tal testconfig)) + (stepname (car ezstep))) + ;; if logpro-used read in the stepname.dat file + (if (and logpro-used (common:file-exists? (conc stepname ".dat"))) + (launch:load-logpro-dat run-id test-id stepname)) + (if (steprun-good? logpro-used (launch:einf-exit-code exit-info)) + (if (not (null? tal)) + (loop (car tal) (cdr tal) stepname)) + (debug:print 4 *default-log-port* "WARNING: step " (car ezstep) " failed. Stopping"))) + (debug:print 4 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep)))))) + ;; by this point we are done with runtest and ezsteps. we can now check if there is + ;; a request for a sub-megatest run and execute it + + + ))) (define (launch:monitor-job run-id test-id item-path fullrunscript ezsteps test-name tconfigreg exit-info m work-area runtlim misc-flags) (let* ((update-period (string->number (or (configf:lookup *configdat* "setup" "test-stats-update-period") "30"))) (start-seconds (current-seconds)) (calc-minutes (lambda () @@ -423,10 +492,11 @@ (top-path (assoc/default 'toppath cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) ;; work-area is the test run area (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (ezsteps (assoc/default 'ezsteps cmdinfo)) + (subrun (assoc/default 'subrun cmdinfo)) ;; (runremote (assoc/default 'runremote cmdinfo)) ;; (transport (assoc/default 'transport cmdinfo)) ;; not used ;; (serverinf (assoc/default 'serverinf cmdinfo)) ;; (port (assoc/default 'port cmdinfo)) (serverurl (assoc/default 'serverurl cmdinfo)) @@ -503,11 +573,11 @@ (change-directory *toppath*) ;; temporarily switch to the run area home (setenv "MT_TEST_RUN_DIR" work-area) (launch:setup) ;; should be properly in the run area home now - (set! tconfigreg (tests:get-all)) + (set! tconfigreg (tests:get-all)) ;; mapping of testname => test source path (let ((sighand (lambda (signum) ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting (if (eq? signum signal/stop) (debug:print-error 0 *default-log-port* "attempt to STOP process. Exiting.")) (set! *time-to-exit* #t) @@ -582,20 +652,22 @@ (let ((rconfig (full-runconfigs-read)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))) (wconfig (read-config "waivers.config" #f #t sections: `( "default" ,target )))) ;; read the waivers config if it exists ;; (setup-env-defaults (conc *toppath* "/runconfigs.config") run-id (make-hash-table) keyvals target) ;; (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id)) ;; Now have runconfigs data loaded, set environment vars - (for-each (lambda (section) - (for-each (lambda (varval) - (let ((var (car varval)) - (val (cadr varval))) - (if (and (string? var)(string? val)) - (begin - (setenv var (config:eval-string-in-environment val))) ;; val) - (debug:print-error 0 *default-log-port* "bad variable spec, " var "=" val)))) - (configf:get-section rconfig section))) - (list "default" target))) + (for-each + (lambda (section) + (for-each + (lambda (varval) + (let ((var (car varval)) + (val (cadr varval))) + (if (and (string? var)(string? val)) + (begin + (setenv var (config:eval-string-in-environment val))) ;; val) + (debug:print-error 0 *default-log-port* "bad variable spec, " var "=" val)))) + (configf:get-section rconfig section))) + (list "default" target))) ;;(bb-check-path msg: "launch:execute post block 1") ;; NFS might not have propagated the directory meta data to the run host - give it time if needed (let loop ((count 0)) (if (or (common:file-exists? work-area) @@ -691,11 +763,11 @@ ;; (keep-going #t) (misc-flags (let ((ht (make-hash-table))) (hash-table-set! ht 'keep-going #t) ht)) (runit (lambda () - (launch:manage-steps run-id test-id item-path fullrunscript ezsteps test-name tconfigreg exit-info m))) + (launch:manage-steps run-id test-id item-path fullrunscript ezsteps subrun test-name tconfigreg exit-info m))) (monitorjob (lambda () (launch:monitor-job run-id test-id item-path fullrunscript ezsteps test-name tconfigreg exit-info m work-area runtlim misc-flags))) (th1 (make-thread monitorjob "monitor job")) (th2 (make-thread runit "run job"))) (set! job-thread th2) @@ -1017,11 +1089,11 @@ ;; one more attempt to cache the configs for future reading (let* ((cachefiles (launch:get-cache-file-paths areapath toppath target mtconfig)) (mtcachef (car cachefiles)) (rccachef (cdr cachefiles))) - ;; trap exception due to stale NFS handle -- Error: (open-output-file) cannot open file - Stale NFS file handle: "/p/fdk/gwa/lefkowit/mtTesting/qa/primbeqa/links/p1222/11/PDK_r1.1.1/prim/clean/pcell_testgen/.runconfigs.cfg-1.6427-7d1e789cb3f62f9cde719a4865bb51b3c17ea853" - ticket 220546342 + ;; trap exception due to stale NFS handle -- Error: (open-output-file) cannot open file - Stale NFS file handle: "...somepath.../.runconfigs.cfg-1.6427-7d1e789cb3f62f9cde719a4865bb51b3c17ea853" - ticket 220546342 ;; TODO - consider 1) using simple-lock to bracket cache write ;; 2) cache in hash on server, since need to do rmt: anyway to lock. (if (and rccachef *runconfigdat* (not (common:file-exists? rccachef))) (common:fail-safe (lambda () @@ -1301,11 +1373,12 @@ (if (equal? ush "no") ;; must use "no" to NOT use shell #f ush) #t))) ;; default is yes (runscript (config-lookup tconfig "setup" "runscript")) - (ezsteps (> (length (hash-table-ref/default tconfig "ezsteps" '())) 0)) ;; don't send all the steps, could be big + (ezsteps (> (length (hash-table-ref/default tconfig "ezsteps" '())) 0)) ;; don't send all the steps, could be big, just send a flag + (subrun (> (length (hash-table-ref/default tconfig "subrun" '())) 0)) ;; send a flag to process a subrun ;; (diskspace (config-lookup tconfig "requirements" "diskspace")) ;; (memory (config-lookup tconfig "requirements" "memory")) ;; (hosts (config-lookup *configdat* "jobtools" "workhosts")) ;; I'm pretty sure this was never completed (remote-megatest (config-lookup *configdat* "setup" "executable")) (run-time-limit (or (configf:lookup tconfig "requirements" "runtimelim") @@ -1385,11 +1458,12 @@ (list 'run-id run-id ) (list 'test-id test-id ) ;; (list 'item-path item-path ) (list 'itemdat itemdat ) (list 'megatest remote-megatest) - (list 'ezsteps ezsteps) + (list 'ezsteps ezsteps) + (list 'subrun subrun) (list 'target mt_target) (list 'contour contour) (list 'runtlim (if run-time-limit (common:hms-string->seconds run-time-limit) #f)) (list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '())) (list 'set-vars (if params (hash-table-ref/default params "-setvars" #f))) Index: megatest.config ================================================================== --- megatest.config +++ megatest.config @@ -20,11 +20,11 @@ # the target translator can return: a/target OR (list/of targets/to apply/run) OR #f i.e. run nothing # ext-tests path=ext-tests; targtrans=prefix-contour; ext path=ext-tests [contours] -# mode-patt/tag-expr +# selector=tag-expr/mode-patt quick areas=ext; selector=/QUICKPATT quick2 areafn=check-area; selector=/QUICKPATT # quick areas=fullrun,ext-tests; selector=QUICKPATT/quick # full areas=fullrun,ext-tests; selector=MAXPATT/ # short areas=fullrun,ext-tests; selector=MAXPATT/