Index: env.scm ================================================================== --- env.scm +++ env.scm @@ -21,20 +21,22 @@ (declare (unit env)) (use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables) (define (env:open-db fname) - (let* ((db-exists (common:file-exists? fname)) + (let* ((db-exists (if (equal? fname ":memory:") + #f + (common:file-exists? fname))) (db (open-database fname))) (if (not db-exists) (begin - (exec (sql db "CREATE TABLE envvars ( - id INTEGER PRIMARY KEY, - context TEXT NOT NULL, - var TEXT NOT NULL, - val TEXT NOT NULL, - CONSTRAINT envvars_constraint UNIQUE (context,var))")))) + (exec (sql db "CREATE TABLE IF NOT EXISTS envvars ( + id INTEGER PRIMARY KEY, + context TEXT NOT NULL, + var TEXT NOT NULL, + val TEXT NOT NULL, + CONSTRAINT envvars_constraint UNIQUE (context,var))")))) (set-busy-handler! db (busy-timeout 10000)) db)) ;; save vars in given context, this is NOT incremental by default ;; @@ -77,10 +79,33 @@ val))))) (sql db "SELECT var,val FROM envvars WHERE context=?") context)) contexts) result)) + +;; envdelta: a-b (start=a, end=b, get the delta) +;; ofile: #f = write to stdout, else write to file with string name +;; +(define (env:envdelta db envdelta ofile) + (let ((match (string-split envdelta "-")));; (string-match "([a-z0-9_]+)=([a-z0-9_\\-,]+)" envdelta))) + (if (not (null? match)) + (let* ((parts match) ;; (string-split equn "-")) + (minuend (car parts)) + (subtraend (cadr parts)) + (added (env:get-added db minuend subtraend)) + (removed (env:get-removed db minuend subtraend)) + (changed (env:get-changed db minuend subtraend))) + ;; (pp (hash-table->alist added)) + ;; (pp (hash-table->alist removed)) + ;; (pp (hash-table->alist changed)) + (if (args:get-arg "-o") + (with-output-to-file + (args:get-arg "-o") + (lambda () + (env:print added removed changed))) + (env:print added removed changed))) + #f))) ;; get list of removed variables between two contexts ;; (define (env:get-removed db contexta contextb) (let ((result (make-hash-table))) Index: ezsteps.scm ================================================================== --- ezsteps.scm +++ ezsteps.scm @@ -34,21 +34,82 @@ (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") -;;(rmt:get-test-info-by-id run-id test-id) -> testdat +(define (ezsteps:step-name->mode stepname) + (match (string-search "\\.([^\\.]+)$" stepname) + ((_ ext) (string->symbol ext)) + (else #f))) + +(define (ezsteps:create-step-script envdbf stepname prevstepname mode cmd shellexe) + (let* (#;(shebang (case mode + ((sh) "/bin/sh") + ((csh) "/bin/csh") + (else "/bin/bash"))) + (sourcef (conc ".ezsteps/vars_" prevstepname "." mode)) + (scriptn (conc "ez_" stepname))) ;; remember the name already has an extension .sh, .csh etc. + (with-output-to-file scriptn + (lambda () + ;; the shebang line + (print "#!" shellexe) + ;; first setup the source of the previous changes + (if (file-exists? sourcef) + (print "source " sourcef)) + ;; save the env at start + (print "megatest -envcap "stepname"_start "envdbf) + ;; run the command + (print cmd) + (if (eq? mode 'csh) + (print "set ecode=$?") + (print "ecode=$?")) + ;; save the env at end + (print "megatest -envcap "stepname"_end "envdbf) + ;; write the delta + (print "megatest -envdelta "stepname"_start-"stepname"_end -dumpmode bash -o .ezsteps/vars_"stepname".sh "envdbf) + (print "megatest -envdelta "stepname"_start-"stepname"_end -dumpmode csh -o .ezsteps/vars_"stepname".csh "envdbf) + (print "exit $ecode"))) + (system (conc "chmod a+x " scriptn)))) + +(define (ezsteps:get-ezpropvars res) ;; testconfig) + ;; (let* ((res (configf:lookup testconfig "setup" "ezpropvars"))) + (if (string? res) + (let* ((dat (string-split res))) + (match dat + ((s shellexe) + (let ((shl (string->symbol s))) + `(,shl . ,shellexe))) + ((s) + (let* ((shl (string->symbol s)) + (shellexe (if (eq? shl 'csh) "/bin/csh" "/bin/bash"))) + `(,shl . ,shellexe))) + (else #f))) + #f)) -;; TODO: deprecate me in favor of ezsteps.scm +;; NOTE: returns logpro-used? ;; -(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat) +(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat prevstepname envdbf) (let* ((stepname (car ezstep)) ;; do stuff to run the step + (stepmode-n (ezsteps:step-name->mode stepname)) (stepinfo (cadr ezstep)) - ;; (let ((info (cadr ezstep))) - ;; (if (proc? info) "" info))) - ;; (stepproc (let ((info (cadr ezstep))) - ;; (if (proc? info) info #f))) + (shellmode (ezsteps:get-ezpropvars (configf:lookup testconfig "setup" "ezpropvars"))) ;; returns '(csh|sh . "/path/to/shell") + (stepmode (if stepmode-n ;; the .sh or .csh always wins + stepmode-n + (if shellmode + (car shellmode) + #f))) + (shellexe (if stepmode-n + (case stepmode + ((csh) "/bin/csh") + (else "/bin/bash")) + (if shellmode + (cdr shellmode) + "/bin/bash"))) + ;; (let ((info (cadr ezstep))) + ;; (if (proc? info) "" info))) + ;; (stepproc (let ((info (cadr ezstep))) + ;; (if (proc? info) info #f))) (stepparts (string-match (regexp "^(\\{([^\\}\\{]*)\\}\\s*|)(.*)$") stepinfo)) (stepparams (if (and (list? stepparts) (> (length stepparts) 1)) (list-ref stepparts 2) #f)) ;; for future use, {VAR=1,2,3}, run step for each @@ -80,13 +141,16 @@ ";;") (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 + (debug:print 4 *default-log-port* "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo + " stepparts: " stepparts " stepparams: " stepparams " stepcmd: " stepcmd) - + + (if stepmode (ezsteps:create-step-script envdbf stepname prevstepname stepmode stepcmd shellexe)) + ;; ;; 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)) ;; (set! script (conc script "source " prev-env)))) @@ -98,11 +162,14 @@ (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f) ;; 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 + (let* ((cmd (conc (if stepmode + (conc "ez_" stepname) + stepcmd) + " > " stepname ".log 2>&1")) ;; >outfile 2>&1 (pid #f)) (let ((proc (lambda () (set! pid (process-run "/bin/bash" (list "-c" cmd)))))) (if subrun (begin Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -168,11 +168,14 @@ (append (or ezstepslst '()) (list (list "subrun" (conc "{subrun=true} " mt-cmd))))))) ;; process the ezsteps (if ezsteps - (let* ((all-steps-dat (make-hash-table))) ;; keep all the info around as stepname ==> alist; where 'params is the params list (add other stuff as needed) + (let* ((envdbf (conc "/tmp/."(current-user-name)"-"(current-process-id)"-"run-id"-"test-id".db")) + (all-steps-dat (make-hash-table))) ;; keep all the info around as stepname ==> alist; + ;;; where 'params is the params list (add other + ;;; stuff as needed) (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)) @@ -179,11 +182,12 @@ (tal (cdr ezstepslst)) (prevstep #f)) (debug:print-info 0 *default-log-port* "Processing ezstep \"" (string-intersperse ezstep " ") "\"") ;; 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 all-steps-dat)) + (let* ((logpro-used (launch:runstep ezstep run-id test-id exit-info m + tal testconfig all-steps-dat prevstep envdbf)) (stepname (car ezstep)) (stepparms (hash-table-ref all-steps-dat stepname))) (setenv "MT_STEP_NAME" stepname) (pp (hash-table->alist all-steps-dat)) ;; if logpro-used read in the stepname.dat file @@ -1544,12 +1548,11 @@ (append (list (list "MT_TEST_RUN_DIR" work-area) (list "MT_TEST_NAME" test-name) (list "MT_ITEM_INFO" (conc itemdat)) (list "MT_RUNNAME" runname) (list "MT_TARGET" mt_target) - (list "MT_ITEMPATH" item-path) - ) + (list "MT_ITEMPATH" item-path)) itemdat))) (testprevvals (alist->env-vars (hash-table-ref/default tconfig "pre-launch-env-overrides" '()))) ;; Launchwait defaults to true, must override it to turn off wait (launchwait (if (equal? (configf:lookup *configdat* "setup" "launchwait") "no") #f #t)) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -868,11 +868,14 @@ (let* ((db (env:open-db (if (null? remargs) "envdat.db" (car remargs))))) (env:save-env-vars db envcap) (env:close-database db) (set! *didsomething* #t)))) -;; delta "language" will eventually be res=a+b-c but for now it is just res=a-b +;; delta "language" will eventually be res=a+b-c but for now it is just res=a-b +;; +;; db file can be stuck on the end of the command line: +;; megatest -envdelta start-end -dumpmode bash -o .ezsteps/step5.sh /tmp/myfile.db ;; (let ((envdelta (args:get-arg "-envdelta"))) (if envdelta (let ((match (string-split envdelta "-")));; (string-match "([a-z0-9_]+)=([a-z0-9_\\-,]+)" envdelta))) (if (not (null? match)) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -635,17 +635,17 @@ (runs:run-pre-hook run-id) ;; mark all test launced flag as false in the meta table (rmt:set-var (conc "lunch-complete-" run-id) "no") (debug:print-info 1 *default-log-port* "Setting end-of-run to no") (let* ((config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns"))) - (if x (string->number x) #f))) - (config-rerun-cnt (if config-reruns - config-reruns - 1))) - (if (eq? config-rerun-cnt run-count) - (rmt:set-var (conc "end-of-run-" run-id) "no"))) - + (if x (string->number x) #f))) + (config-rerun-cnt (if config-reruns + config-reruns + 1))) + (if (eq? config-rerun-cnt run-count) + (rmt:set-var (conc "end-of-run-" run-id) "no"))) + (rmt:set-run-state-status run-id "new" "n/a") ;; now add non-directly referenced dependencies (i.e. waiton) ;;====================================================================== ;; refactoring this block into tests:get-full-data ;; @@ -759,19 +759,10 @@ (debug:print-info 4 *default-log-port* "test-records=" (hash-table->alist test-records)) (let ((reglen (configf:lookup *configdat* "setup" "runqueue"))) (if (> (length (hash-table-keys test-records)) 0) (let* ((keep-going #t) (run-queue-retries 5) - #;(th1 (make-thread (lambda () - (handle-exceptions - exn - (begin - (print-call-chain) - (print " message: " ((condition-property-accessor 'exn 'message) exn))) - (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests - (any->number reglen) all-tests-registry))) - "runs:run-tests-queue")) (th2 (make-thread (lambda () ;; BBQ: why are we visiting ALL runs here? ;; (rmt:find-and-mark-incomplete-all-runs))))) CAN'T INTERRUPT IT ... (let ((run-ids (rmt:get-all-run-ids))) (for-each (lambda (run-id) (if keep-going @@ -784,14 +775,11 @@ (rmt:find-and-mark-incomplete run-id #f) (hash-table-set! *find-and-mark-incomplete-last-run* run-id (current-seconds))) )))) ;; ovr-deadtime))) ;; could be root of https://hsdes.intel.com/appstore/article/#/220546828/main -- Title: Megatest jobs show DEAD even though they are still running (1.64/27) run-ids))) "runs: mark-incompletes"))) - ;; (thread-start! th1) (thread-start! th2) - ;; (thread-join! th1) - ;; just do the main stuff in the main thread (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry) (set! keep-going #f) (thread-join! th2) ;; if run-count > 0 call, set -preclean and -rerun STUCK/DEAD @@ -800,12 +788,12 @@ (if (not (hash-table-ref/default flags "-preclean" #f)) (hash-table-set! flags "-preclean" #t)) (if (not (hash-table-ref/default flags "-rerun" #f)) (hash-table-set! flags "-rerun" "STUCK/DEAD,n/a,ZERO_ITEMS")) ;; recursive call to self - (runs:run-tests target runname test-patts user flags run-count: (- run-count 1))) - (launch:end-of-run-check run-id))) + (runs:run-tests target runname test-patts user flags run-count: (- run-count 1))) + (launch:end-of-run-check run-id))) (debug:print-info 0 *default-log-port* "No tests to run"))) (debug:print-info 4 *default-log-port* "All done by here") ;; TODO: try putting post hook call here ; (debug:print-info 2 *default-log-port* " run-count " run-count) @@ -1879,11 +1867,11 @@ (begin ;; Here we mark any old defunct tests as incomplete. Do this every fifteen minutes ;; (debug:print 0 *default-log-port* "Got here eh! num-running=" num-running " (> num-running 0) " (> num-running 0)) (if (> (- (current-seconds)(hash-table-ref/default *find-and-mark-incomplete-last-run* run-id 0)) 900) ;; (begin(if (> (current-seconds)(+ last-time-incomplete 900)) - (let ((actual-num-running (rmt:get-count-tests-running-for-run-id run-id))) + (let ((actual-num-running num-running)) ;; (rmt:get-count-tests-running-for-run-id run-id))) ;; why call it again? (debug:print-info 0 *default-log-port* "Marking stuck tests as INCOMPLETE while waiting for run " run-id ". Running as pid " (current-process-id) " on " (get-host-name)) ;; (set! last-time-incomplete (current-seconds)) ;; FIXME, this might be causing slow down - use of set! (rmt:find-and-mark-incomplete run-id #f) (hash-table-set! *find-and-mark-incomplete-last-run* run-id (current-seconds))