Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -27,11 +27,11 @@
process.scm runs.scm tasks.scm tests.scm genexample.scm \
http-transport.scm filedb.scm tdb.scm \
client.scm mt.scm \
ezsteps.scm lock-queue.scm sdb.scm \
rmt.scm api.scm subrun.scm \
- portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm
+ portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm redo-logpro.scm
# module source files
MSRCFILES = ftail.scm
# Eggs to install (straightforward ones)
@@ -115,11 +115,12 @@
server.o \
tasks.o \
tdb.o \
tests.o \
subrun.o \
-
+ ezsteps.o \
+ redo-logpro.o
tcmt : $(TCMTOBJS) tcmt.scm
csc $(CSCOPTS) $(TCMTOBJS) tcmt.scm -o tcmt
# install documentation to $(PREFIX)/docs
Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -84,10 +84,13 @@
)
;; GLOBALS
+;; job exit info
+(defstruct launch:einf (pid #t)(exit-status #t)(exit-code #t)(rollup-status 0))
+
;; CONTEXTS
(defstruct cxt
(taskdb #f)
(cmutex (make-mutex)))
;; (define *contexts* (make-hash-table))
Index: ezsteps.scm
==================================================================
--- ezsteps.scm
+++ ezsteps.scm
@@ -17,11 +17,11 @@
;; along with Megatest. If not, see .
;;
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
-(use srfi-1 posix regex srfi-69 directory-utils)
+(use srfi-1 posix regex srfi-69 directory-utils call-with-environment-variables)
(declare (unit ezsteps))
(declare (uses db))
(declare (uses common))
(declare (uses items))
@@ -33,19 +33,337 @@
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
+
+;;======================================================================
+;; ezsteps
+;;======================================================================
+
+;; ezsteps were going to be coded as
+;; stepname[,predstep1,predstep2 ...] [{VAR1=first,second,third}] command to execute
+;; BUT
+;; now are
+;; stepname {VAR=first,second,third ...} command ...
+;; where the {VAR=first,second,third ...} is optional.
+
+;; given an exit code and whether or not logpro was used calculate OK/BAD
+;; return #t if we are ok, #f otherwise
+(define (ezsteps:steprun-good? logpro exitcode)
+ (or (eq? exitcode 0)
+ (and logpro (eq? exitcode 2))))
+
+(define (ezsteps: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
+ ;; any of the other stuff that tests:test-set-status! does. Let's just
+ ;; force RUNNING/n/a
+
+ ;; (thread-sleep! 0.3)
+ ;; (tests:test-force-state-status! run-id test-id "RUNNING" "n/a")
+ (rmt:set-state-status-and-roll-up-items run-id test-name item-path "RUNNING" #f #f)
+ ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here
+
+ ;; if there is a runscript do it first
+ (if fullrunscript
+ (let ((pid (process-run fullrunscript)))
+ (rmt:test-set-top-process-pid run-id test-id pid)
+ (let loop ((i 0))
+ (let-values
+ (((pid-val exit-status exit-code) (process-wait pid #t)))
+ (mutex-lock! m)
+ (launch:einf-pid-set! exit-info pid) ;; (vector-set! exit-info 0 pid)
+ (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
+ (launch:einf-exit-code-set! exit-info exit-code) ;; (vector-set! exit-info 2 exit-code)
+ (launch:einf-rollup-status-set! exit-info exit-code) ;; (vector-set! exit-info 3 exit-code) ;; rollup status
+ (mutex-unlock! m)
+ (if (eq? pid-val 0)
+ (begin
+ (thread-sleep! 2)
+ (loop (+ i 1)))
+ )))))
+ ;; then, if runscript ran ok (or did not get called)
+ ;; do all the ezsteps (if any)
+ (if (or ezsteps subrun)
+ (let* ((test-run-dir (tests:get-test-path-from-environment))
+ (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)
+ (hash-table-ref/default testconfig "ezsteps" '())
+ #f)))
+ (if testconfig
+ (hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ...
+ (begin
+ (launch:setup)
+ (debug:print 0 *default-log-port* "WARNING: no testconfig found for " test-name " in search path:\n "
+ (string-intersperse (tests:get-tests-search-path *configdat*) "\n "))))
+ ;; 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)))
+
+ ;; 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
+ (when (configf:lookup testconfig "subrun" "runwait") ;; we use runwait as the flag that a subrun is requested
+ (subrun:initialize-toprun-test testconfig test-run-dir)
+ (let* ((mt-cmd (subrun:launch-cmd test-run-dir)))
+ (debug:print-info 0 *default-log-port* "Subrun command is \"" mt-cmd "\"")
+ (set! ezsteps #t) ;; set the needed flag
+ (set! ezstepslst
+ (append (or ezstepslst '())
+ (list (list "subrun" (conc "{subrun=true} " mt-cmd)))))))
+
+ ;; 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))
+ (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
+ (ezsteps:runstep ezstep run-id test-id
+ exit-info: exit-info mutix: m is-last-step: (null? tal) testconfig: 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 (ezsteps:steprun-good? logpro-used (launch:einf-exit-code exit-info))
+ (if (not (null? tal))
+ (loop (car tal) (cdr tal) stepname))
+ (debug:print 0 *default-log-port* "WARNING: step " (car ezstep) " failed. Stopping")))
+ (debug:print 0 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep)))))))))
+
;;(rmt:get-test-info-by-id run-id test-id) -> testdat
+(define (ezsteps:runstep ezstep run-id test-id #!key
+ (exit-info (make-launch:einf pid: #t exit-status: #t exit-code: #t rollup-status: 0)) ;; pid exit-status exit-code (i.e. process was successfully run) rollup-status
+ (mutex (make-mutex))
+ (testconfig (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t))
+ (ezsteplst (hash-table-ref/default testconfig "ezsteps" '()))
+ (is-last-step #f))
+ (let* ((stepname (if (list? ezsteplst) (car ezstep) ezstep)) ;; do stuff to run the step
+ (stepinfo (if (list? ezsteplst)
+ (cadr ezstep)
+ (let loop ((tocheck ezsteplst))
+ (cond
+ ((null? tocheck) #f)
+ ((equal? (caar tocheck) ezstep)
+ (cadar tocheck))
+ (else (loop (cdr tocheck))))))))
+ (if stepinfo
+ (let* (
+ ;; (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 (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each
+ (paramparts (if (string? 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"))
+ (tconfig-logpro (configf:lookup testconfig "logpro" stepname))
+ (logpro-used (common:file-exists? logpro-file)))
+
+ (debug:print 0 *default-log-port* "stepparts: " stepparts ", stepparams: " stepparams
+ ", paramparts: " paramparts ", subrun: " subrun ", stepcmd: " stepcmd)
+
+ (if (and tconfig-logpro
+ (not logpro-used)) ;; no logpro file found but have a defn in the testconfig
+ (begin
+ (with-output-to-file logpro-file
+ (lambda ()
+ (print ";; logpro file extracted from testconfig\n"
+ ";;")
+ (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
+ " 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))
+ ;; (set! script (conc script "source " prev-env))))
+
+ ;; call the command using mt_ezstep
+ ;; (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "x") " " stepcmd))
+
+ (debug:print 4 *default-log-port* "script: " script)
+ (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
+ (pid #f))
+ (let ((proc (lambda ()
+ (set! pid (process-run "/bin/bash" (list "-c" cmd))))))
+ (if subrun
+ (begin
+ (debug:print-info 0 *default-log-port* "Running without MT_.* environment variables.")
+ (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"))
+ (print "\tlogpro " stepname ".logpro " stepname ".html < " stepname ".log"))
+ (print)
+ (print stepname " : " stepname ".log")
+ (print))
+ #:append)
+ (rmt:test-set-top-process-pid run-id test-id pid)
+ (let processloop ((i 0))
+ (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
+ (mutex-lock! mutex)
+ (launch:einf-pid-set! exit-info pid) ;; (vector-set! exit-info 0 pid)
+ (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
+ (launch:einf-exit-code-set! exit-info exit-code) ;; (vector-set! exit-info 2 exit-code)
+ (mutex-unlock! mutex)
+ (if (eq? pid-val 0)
+ (begin
+ (thread-sleep! 2)
+ (processloop (+ i 1))))
+ )))))
+ (debug:print-info 0 *default-log-port* "step " stepname " completed with exit code " (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
+ ;; now run logpro if needed
+ (if logpro-used
+ (let* ((logpro-exe (or (getenv "LOGPRO_EXE") "logpro"))
+ (pid (process-run (conc "/bin/sh -c '"logpro-exe" "logpro-file " " (conc stepname ".html") " < " stepname ".log > /dev/null'"))))
+ (let processloop ((i 0))
+ (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
+ (mutex-lock! mutex)
+ ;; (make-launch:einf pid: pid exit-status: exit-status exit-code: exit-code)
+ (launch:einf-pid-set! exit-info pid) ;; (vector-set! exit-info 0 pid)
+ (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
+ (launch:einf-exit-code-set! exit-info exit-code) ;; (vector-set! exit-info 2 exit-code)
+ (mutex-unlock! mutex)
+ (if (eq? pid-val 0)
+ (begin
+ (thread-sleep! 2)
+ (processloop (+ i 1)))))
+ (debug:print-info 0 *default-log-port* "logpro for step " stepname " exited with code " (launch:einf-exit-code exit-info))))) ;; (vector-ref exit-info 2)))))
+
+ (let ((exinfo (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
+ (logfna (if logpro-used (conc stepname ".html") ""))
+ (comment #f))
+ (if logpro-used
+ (let ((datfile (conc stepname ".dat")))
+ ;; load the .dat file into the test_data table if it exists
+ (if (common:file-exists? datfile)
+ (set! comment (launch:load-logpro-dat run-id test-id stepname)))
+ (rmt:test-set-log! run-id test-id (conc stepname ".html"))))
+ (rmt:teststep-set-status! run-id test-id stepname "end" exinfo comment logfna))
+ ;; set the test final status
+ (let* ((process-exit-status (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
+ (this-step-status (cond
+ ((and (eq? process-exit-status 2) logpro-used) 'warn) ;; logpro 2 = warnings
+ ((and (eq? process-exit-status 3) logpro-used) 'check) ;; logpro 3 = check
+ ((and (eq? process-exit-status 4) logpro-used) 'waived) ;; logpro 4 = waived
+ ((and (eq? process-exit-status 5) logpro-used) 'abort) ;; logpro 5 = abort
+ ((and (eq? process-exit-status 6) logpro-used) 'skip) ;; logpro 6 = skip
+ ((eq? process-exit-status 0) 'pass) ;; logpro 0 = pass
+ (else 'fail)))
+ (overall-status (cond
+ ((eq? (launch:einf-rollup-status exit-info) 2) 'warn) ;; rollup-status (vector-ref exit-info 3)
+ ((eq? (launch:einf-rollup-status exit-info) 0) 'pass) ;; (vector-ref exit-info 3)
+ (else 'fail)))
+ (next-status (cond
+ ((eq? overall-status 'pass) this-step-status)
+ ((eq? overall-status 'warn)
+ (if (eq? this-step-status 'fail) 'fail 'warn))
+ ((eq? overall-status 'abort) 'abort)
+ (else 'fail)))
+ (next-state ;; "RUNNING") ;; WHY WAS THIS CHANGED TO NOT USE (null? tal) ??
+ (cond
+ (is-last-step ;; more to run?
+ "COMPLETED")
+ (else "RUNNING"))))
+ (debug:print 4 *default-log-port* "Exit value received: " (launch:einf-exit-code exit-info) " logpro-used: " logpro-used
+ " this-step-status: " this-step-status " overall-status: " overall-status
+ " next-status: " next-status " rollup-status: " (launch:einf-rollup-status exit-info)) ;; (vector-ref exit-info 3))
+ (case next-status
+ ((warn)
+ (launch:einf-rollup-status-set! exit-info 2) ;; (vector-set! exit-info 3 2) ;; rollup-status
+ ;; NB// test-set-status! does rdb calls under the hood
+ (tests:test-set-status! run-id test-id next-state "WARN"
+ (if (eq? this-step-status 'warn) "Logpro warning found" #f)
+ #f))
+ ((check)
+ (launch:einf-rollup-status-set! exit-info 3) ;; (vector-set! exit-info 3 3) ;; rollup-status
+ ;; NB// test-set-status! does rdb calls under the hood
+ (tests:test-set-status! run-id test-id next-state "CHECK"
+ (if (eq? this-step-status 'check) "Logpro check found" #f)
+ #f))
+ ((waived)
+ (launch:einf-rollup-status-set! exit-info 4) ;; (vector-set! exit-info 3 3) ;; rollup-status
+ ;; NB// test-set-status! does rdb calls under the hood
+ (tests:test-set-status! run-id test-id next-state "WAIVED"
+ (if (eq? this-step-status 'check) "Logpro waived found" #f)
+ #f))
+ ((abort)
+ (launch:einf-rollup-status-set! exit-info 5) ;; (vector-set! exit-info 3 4) ;; rollup-status
+ ;; NB// test-set-status! does rdb calls under the hood
+ (tests:test-set-status! run-id test-id next-state "ABORT"
+ (if (eq? this-step-status 'abort) "Logpro abort found" #f)
+ #f))
+ ((skip)
+ (launch:einf-rollup-status-set! exit-info 6) ;; (vector-set! exit-info 3 4) ;; rollup-status
+ ;; NB// test-set-status! does rdb calls under the hood
+ (tests:test-set-status! run-id test-id next-state "SKIP"
+ (if (eq? this-step-status 'skip) "Logpro skip found" #f)
+ #f))
+ ((pass)
+ (tests:test-set-status! run-id test-id next-state "PASS" #f #f))
+ (else ;; 'fail
+ (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)
+ (begin
+ (debug:print-error 0 *default-log-port* "ezstep named "ezstep" does not exist for testid="test-id)
+ #f))))
-(define (ezsteps:run-from testdat start-step-name run-one)
+(define (ezsteps:run-from testdat start-step-name-in run-one #!key (rerun-logpro-only #f) )
+ ;; TODO: honor rerun-logpro-only
+ (if rerun-logpro-only
+ (BB> "someday soon...")
(let* ((test-run-dir ;; (filedb:get-path *fdb*
(db:test-get-rundir testdat)) ;; )
(testconfig (read-config (conc test-run-dir "/testconfig") #f #t environ-patt: "pre-launch-env-vars"))
(ezstepslst (hash-table-ref/default testconfig "ezsteps" '()))
+ (start-step-name (or start-step-name-in (if (null? ezsteplst) #f (car ezsteplst))))
(run-mutex (make-mutex))
(rollup-status 0)
(exit-info (vector #t #t #t))
(test-id (db:test-get-id testdat))
(run-id (db:test-get-run_id testdat))
@@ -145,11 +463,11 @@
(tests:test-set-status! run-id test-id "RUNNING" "PASS" #f #f))
(else ;; 'fail
(set! rollup-status 1) ;; force fail
(tests:test-set-status! run-id test-id "RUNNING" "FAIL" (conc "Failed at step " stepname) #f)
))))
- (if (and (steprun-good? logpro-used (vector-ref exit-info 2))
+ (if (and (ezsteps:steprun-good? logpro-used (vector-ref exit-info 2))
(not (null? tal)))
(if (not run-one) ;; if we got here we completed the step, if run-one is true, stop
(loop (car tal) (cdr tal) stepname runflag))))
(debug:print 4 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep)))
@@ -184,15 +502,15 @@
;; for automated creation of the rollup html file this is a good place...
(if (not (equal? item-path ""))
(tests:summarize-items run-id test-id test-name #f)) ;; don't force - just update if no
)))
(pop-directory)
- rollup-status))
+ rollup-status)))
(define (ezsteps:spawn-run-from testdat start-step-name run-one)
(thread-start!
(make-thread
(lambda ()
(ezsteps:run-from testdat start-step-name run-one))
(conc "ezstep run single step " start-step-name " run-one="run-one)))
)
Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -30,41 +30,25 @@
(declare (unit launch))
(declare (uses subrun))
(declare (uses common))
(declare (uses configf))
(declare (uses db))
-
+(declare (uses ezsteps)) ;; why does this break things?
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
-;;======================================================================
-;; ezsteps
-;;======================================================================
-
-;; ezsteps were going to be coded as
-;; stepname[,predstep1,predstep2 ...] [{VAR1=first,second,third}] command to execute
-;; BUT
-;; now are
-;; stepname {VAR=first,second,third ...} command ...
-;; where the {VAR=first,second,third ...} is optional.
-
-;; given an exit code and whether or not logpro was used calculate OK/BAD
-;; return #t if we are ok, #f otherwise
-(define (steprun-good? logpro exitcode)
- (or (eq? exitcode 0)
- (and logpro (eq? exitcode 2))))
;; if handed a string, process it, else look for MT_CMDINFO
(define (launch:get-cmdinfo-assoc-list #!key (encoded-cmd #f))
(let ((enccmd (if encoded-cmd encoded-cmd (getenv "MT_CMDINFO"))))
(if enccmd
(common:read-encoded-string enccmd)
'())))
;; 0 1 2 3
-(defstruct launch:einf (pid #t)(exit-status #t)(exit-code #t)(rollup-status 0))
+
;; return (conc status ": " comment) from the final section so that
;; the comment can be set in the step record in launch.scm
;;
(define (launch:load-logpro-dat run-id test-id stepname)
@@ -85,288 +69,11 @@
((equal? status "PASS") "PASS") ;; skip the message part if status is pass
(status (conc (configf:lookup dat "final" "exit-status") ": " (if msg msg "no message")))
(else #f)))
#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))
- (stepparams (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each
- (paramparts (if (string? 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"))
- (tconfig-logpro (configf:lookup testconfig "logpro" stepname))
- (logpro-used (common:file-exists? logpro-file)))
-
- (debug:print 0 *default-log-port* "stepparts: " stepparts ", stepparams: " stepparams
- ", paramparts: " paramparts ", subrun: " subrun ", stepcmd: " stepcmd)
-
- (if (and tconfig-logpro
- (not logpro-used)) ;; no logpro file found but have a defn in the testconfig
- (begin
- (with-output-to-file logpro-file
- (lambda ()
- (print ";; logpro file extracted from testconfig\n"
- ";;")
- (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
- " 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))
- ;; (set! script (conc script "source " prev-env))))
-
- ;; call the command using mt_ezstep
- ;; (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "x") " " stepcmd))
-
- (debug:print 4 *default-log-port* "script: " script)
- (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
- (pid #f))
- (let ((proc (lambda ()
- (set! pid (process-run "/bin/bash" (list "-c" cmd))))))
- (if subrun
- (begin
- (debug:print-info 0 *default-log-port* "Running without MT_.* environment variables.")
- (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"))
- (print "\tlogpro " stepname ".logpro " stepname ".html < " stepname ".log"))
- (print)
- (print stepname " : " stepname ".log")
- (print))
- #:append)
-
- (rmt:test-set-top-process-pid run-id test-id pid)
- (let processloop ((i 0))
- (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
- (mutex-lock! m)
- (launch:einf-pid-set! exit-info pid) ;; (vector-set! exit-info 0 pid)
- (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
- (launch:einf-exit-code-set! exit-info exit-code) ;; (vector-set! exit-info 2 exit-code)
- (mutex-unlock! m)
- (if (eq? pid-val 0)
- (begin
- (thread-sleep! 2)
- (processloop (+ i 1))))
- )))))
- (debug:print-info 0 *default-log-port* "step " stepname " completed with exit code " (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
- ;; now run logpro if needed
- (if logpro-used
- (let* ((logpro-exe (or (getenv "LOGPRO_EXE") "logpro"))
- (pid (process-run (conc "/bin/sh -c '"logpro-exe" "logpro-file " " (conc stepname ".html") " < " stepname ".log > /dev/null'"))))
- (let processloop ((i 0))
- (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
- (mutex-lock! m)
- ;; (make-launch:einf pid: pid exit-status: exit-status exit-code: exit-code)
- (launch:einf-pid-set! exit-info pid) ;; (vector-set! exit-info 0 pid)
- (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
- (launch:einf-exit-code-set! exit-info exit-code) ;; (vector-set! exit-info 2 exit-code)
- (mutex-unlock! m)
- (if (eq? pid-val 0)
- (begin
- (thread-sleep! 2)
- (processloop (+ i 1)))))
- (debug:print-info 0 *default-log-port* "logpro for step " stepname " exited with code " (launch:einf-exit-code exit-info))))) ;; (vector-ref exit-info 2)))))
-
- (let ((exinfo (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
- (logfna (if logpro-used (conc stepname ".html") ""))
- (comment #f))
- (if logpro-used
- (let ((datfile (conc stepname ".dat")))
- ;; load the .dat file into the test_data table if it exists
- (if (common:file-exists? datfile)
- (set! comment (launch:load-logpro-dat run-id test-id stepname)))
- (rmt:test-set-log! run-id test-id (conc stepname ".html"))))
- (rmt:teststep-set-status! run-id test-id stepname "end" exinfo comment logfna))
- ;; set the test final status
- (let* ((process-exit-status (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
- (this-step-status (cond
- ((and (eq? process-exit-status 2) logpro-used) 'warn) ;; logpro 2 = warnings
- ((and (eq? process-exit-status 3) logpro-used) 'check) ;; logpro 3 = check
- ((and (eq? process-exit-status 4) logpro-used) 'waived) ;; logpro 4 = waived
- ((and (eq? process-exit-status 5) logpro-used) 'abort) ;; logpro 5 = abort
- ((and (eq? process-exit-status 6) logpro-used) 'skip) ;; logpro 6 = skip
- ((eq? process-exit-status 0) 'pass) ;; logpro 0 = pass
- (else 'fail)))
- (overall-status (cond
- ((eq? (launch:einf-rollup-status exit-info) 2) 'warn) ;; rollup-status (vector-ref exit-info 3)
- ((eq? (launch:einf-rollup-status exit-info) 0) 'pass) ;; (vector-ref exit-info 3)
- (else 'fail)))
- (next-status (cond
- ((eq? overall-status 'pass) this-step-status)
- ((eq? overall-status 'warn)
- (if (eq? this-step-status 'fail) 'fail 'warn))
- ((eq? overall-status 'abort) 'abort)
- (else 'fail)))
- (next-state ;; "RUNNING") ;; WHY WAS THIS CHANGED TO NOT USE (null? tal) ??
- (cond
- ((null? tal) ;; more to run?
- "COMPLETED")
- (else "RUNNING"))))
- (debug:print 4 *default-log-port* "Exit value received: " (launch:einf-exit-code exit-info) " logpro-used: " logpro-used
- " this-step-status: " this-step-status " overall-status: " overall-status
- " next-status: " next-status " rollup-status: " (launch:einf-rollup-status exit-info)) ;; (vector-ref exit-info 3))
- (case next-status
- ((warn)
- (launch:einf-rollup-status-set! exit-info 2) ;; (vector-set! exit-info 3 2) ;; rollup-status
- ;; NB// test-set-status! does rdb calls under the hood
- (tests:test-set-status! run-id test-id next-state "WARN"
- (if (eq? this-step-status 'warn) "Logpro warning found" #f)
- #f))
- ((check)
- (launch:einf-rollup-status-set! exit-info 3) ;; (vector-set! exit-info 3 3) ;; rollup-status
- ;; NB// test-set-status! does rdb calls under the hood
- (tests:test-set-status! run-id test-id next-state "CHECK"
- (if (eq? this-step-status 'check) "Logpro check found" #f)
- #f))
- ((waived)
- (launch:einf-rollup-status-set! exit-info 4) ;; (vector-set! exit-info 3 3) ;; rollup-status
- ;; NB// test-set-status! does rdb calls under the hood
- (tests:test-set-status! run-id test-id next-state "WAIVED"
- (if (eq? this-step-status 'check) "Logpro waived found" #f)
- #f))
- ((abort)
- (launch:einf-rollup-status-set! exit-info 5) ;; (vector-set! exit-info 3 4) ;; rollup-status
- ;; NB// test-set-status! does rdb calls under the hood
- (tests:test-set-status! run-id test-id next-state "ABORT"
- (if (eq? this-step-status 'abort) "Logpro abort found" #f)
- #f))
- ((skip)
- (launch:einf-rollup-status-set! exit-info 6) ;; (vector-set! exit-info 3 4) ;; rollup-status
- ;; NB// test-set-status! does rdb calls under the hood
- (tests:test-set-status! run-id test-id next-state "SKIP"
- (if (eq? this-step-status 'skip) "Logpro skip found" #f)
- #f))
- ((pass)
- (tests:test-set-status! run-id test-id next-state "PASS" #f #f))
- (else ;; 'fail
- (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 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
- ;; any of the other stuff that tests:test-set-status! does. Let's just
- ;; force RUNNING/n/a
-
- ;; (thread-sleep! 0.3)
- ;; (tests:test-force-state-status! run-id test-id "RUNNING" "n/a")
- (rmt:set-state-status-and-roll-up-items run-id test-name item-path "RUNNING" #f #f)
- ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here
-
- ;; if there is a runscript do it first
- (if fullrunscript
- (let ((pid (process-run fullrunscript)))
- (rmt:test-set-top-process-pid run-id test-id pid)
- (let loop ((i 0))
- (let-values
- (((pid-val exit-status exit-code) (process-wait pid #t)))
- (mutex-lock! m)
- (launch:einf-pid-set! exit-info pid) ;; (vector-set! exit-info 0 pid)
- (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
- (launch:einf-exit-code-set! exit-info exit-code) ;; (vector-set! exit-info 2 exit-code)
- (launch:einf-rollup-status-set! exit-info exit-code) ;; (vector-set! exit-info 3 exit-code) ;; rollup status
- (mutex-unlock! m)
- (if (eq? pid-val 0)
- (begin
- (thread-sleep! 2)
- (loop (+ i 1)))
- )))))
- ;; then, if runscript ran ok (or did not get called)
- ;; do all the ezsteps (if any)
- (if (or ezsteps subrun)
- (let* ((test-run-dir (tests:get-test-path-from-environment))
- (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)
- (hash-table-ref/default testconfig "ezsteps" '())
- #f)))
- (if testconfig
- (hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ...
- (begin
- (launch:setup)
- (debug:print 0 *default-log-port* "WARNING: no testconfig found for " test-name " in search path:\n "
- (string-intersperse (tests:get-tests-search-path *configdat*) "\n "))))
- ;; 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)))
-
- ;; 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
- (when (configf:lookup testconfig "subrun" "runwait") ;; we use runwait as the flag that a subrun is requested
- (subrun:initialize-toprun-test testconfig test-run-dir)
- (let* ((mt-cmd (subrun:launch-cmd test-run-dir)))
- (debug:print-info 0 *default-log-port* "Subrun command is \"" mt-cmd "\"")
- (set! ezsteps #t) ;; set the needed flag
- (set! ezstepslst
- (append (or ezstepslst '())
- (list (list "subrun" (conc "{subrun=true} " mt-cmd)))))))
-
- ;; 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))
- (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))
- (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 0 *default-log-port* "WARNING: step " (car ezstep) " failed. Stopping")))
- (debug:print 0 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep)))))))))
+
(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 ()
@@ -763,11 +470,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 subrun test-name tconfigreg exit-info m)))
+ (ezsteps: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)
Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -51,10 +51,11 @@
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
+(declare (uses redo-logpro))
(declare (uses ftail))
(import ftail)
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
@@ -115,10 +116,11 @@
-set-state-status X,Y : set state to X and status to Y, requires controls per -remove-runs
-rerun FAIL,WARN... : force re-run for tests with specificed status(s)
-rerun-clean : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
and then run the specified testpatt with -preclean
-rerun-all : set all tests to NOT_STARTED,n/a and run with -preclean
+ -redo-logpro : do not rerun tests, but reapply logpro rules (ez-step flavor tests only; runs all tests unless -testpatt specified)
-lock : lock run specified by target and runname
-unlock : unlock run specified by target and runname
-set-run-status status : sets status for run to status, requires -target and -runname
-get-run-status : gets status for run specified by target and runname
-run-wait : wait on run specified by target and runname
@@ -291,10 +293,11 @@
"-set-toplog"
"-runstep"
"-logpro"
"-m"
"-rerun"
+
"-days"
"-rename-run"
"-to"
;; values and messages
":category"
@@ -402,10 +405,11 @@
;; queries
"-test-paths" ;; get path(s) to a test, ordered by youngest first
"-runall" ;; run all tests, respects -testpatt, defaults to %
"-run" ;; alias for -runall
+ "-redo-logpro"
"-remove-runs"
"-keep-records" ;; use with -remove-runs to remove only the run data
"-rebuild-db"
"-cleanup-db"
"-rollup"
@@ -571,11 +575,11 @@
(process:children #f))
(original-exit exit-code)))))
;; for some switches always print the command to stderr
;;
-(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status")
+(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-redo-logpro")
(debug:print 0 *default-log-port* (string-intersperse (argv) " ")))
;; some switches imply homehost. Exit here if not on homehost
;;
(let ((homehost-required (list "-cleanup-db" "-server")))
@@ -1050,10 +1054,11 @@
(exit 1))
;; put test parameters into convenient variables
(begin
;; check for correct version, exit with message if not correct
(common:exit-on-version-changed)
+ (BB> "before runs:operate-on")
(runs:operate-on action
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
(common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
state: (common:args-get-state)
@@ -1089,10 +1094,18 @@
(general-run-call
"-set-state-status"
"set state and status"
(lambda (target runname keys keyvals)
(operate-on 'set-state-status))))
+
+(when (args:get-arg "-redo-logpro")
+ (BB> "redo-logpro request from command line detected")
+ (general-run-call
+ "-redo-logpro"
+ "rerun logpro in ezsteps"
+ (lambda (target runname keys keyvals)
+ (operate-on 'redo-logpro))))
(if (or (args:get-arg "-set-run-status")
(args:get-arg "-get-run-status"))
(general-run-call
"-set-run-status"
@@ -1241,10 +1254,12 @@
table-rows))))
(set! *didsomething* #t)
(set! *time-to-exit* #t))
+
+
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
ADDED redo-logpro.scm
Index: redo-logpro.scm
==================================================================
--- /dev/null
+++ redo-logpro.scm
@@ -0,0 +1,37 @@
+;; Copyright 2006-2018, Matthew Welland.
+;;
+;; This file is part of Megatest.
+;;
+;; Megatest is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Megatest is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Megatest. If not, see .
+;;
+
+(declare (unit redo-logpro))
+(declare (uses common))
+(declare (uses rmt))
+(declare (uses ezsteps))
+(include "common_records.scm")
+(use matchable)
+(use fmt)
+(use ducttape-lib)
+(define css "")
+
+(define (redo-logpro:redo-logpro run-id test-id testdat)
+ ;; TODO: populate testdat from testid, start-step-name (from first step)
+ ;; TODO: (ezsteps:run-from testdat start-step-name #f rerun-logpro-only: #t))
+
+
+ (BB> "redo-logpro:redo-logpro called with run-id="run-id" test-id="test-id" testdat="testdat)
+ (ezsteps:run-from testdat #f #f rerun-logpro-only: #t)
+ (print "redo-logpro Unimplemented")
+ #f)
Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -28,10 +28,11 @@
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses mt))
(declare (uses archive))
+;;(declare (uses redo-logpro))
;; (declare (uses filedb))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
@@ -2009,10 +2010,11 @@
;; 'set-state-status
;;
;; NB// should pass in keys?
;;
(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(mode #f)(options '()))
+ (BB> "in runs:operate-on with action >"action"<")
(common:clear-caches) ;; clear all caches
(let* ((db #f)
;; (tdbdat (tasks:open-db))
(keys (rmt:get-keys))
(rundat (mt:get-runs-by-patt keys runnamepatt target))
@@ -2023,11 +2025,11 @@
(state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
(rp-mutex (make-mutex))
(bup-mutex (make-mutex))
(keep-records (args:get-arg "-keep-records"))) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode".
- (let* ((write-access-actions '(remove-runs set-state-status archive run-wait))
+ (let* ((write-access-actions '(remove-runs set-state-status archive run-wait redo-logpro))
(dbfile (conc *toppath* "/megatest.db"))
(readonly-mode (not (file-write-access? dbfile))))
(when (and readonly-mode
(member action write-access-actions))
(debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .")
@@ -2068,10 +2070,13 @@
;; (if (equal? testpatt "%")
(tasks:kill-runner target run-name testpatt)
;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt))
(debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
+ ((redo-logpro)
+ (BB> "redo-logpro operate-on hook 1")
+ (debug:print 1 *default-log-port* "Re-applying new logpro rules without rerun for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((set-state-status)
;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
(debug:print 1 *default-log-port* "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((print-run)
(debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
@@ -2132,10 +2137,11 @@
(test-state (db:test-get-state new-test-dat))
(test-fulln (db:test-get-fullname new-test-dat))
(uname (db:test-get-uname new-test-dat))
(toplevel-with-children (and (db:test-get-is-toplevel test)
(> (rmt:test-toplevel-num-items run-id test-name) 0))))
+ (BB> "arrived here 2")
(case action
((remove-runs)
;; if the test is a toplevel-with-children issue an error and do not remove
(cond
(toplevel-with-children
@@ -2202,10 +2208,11 @@
) ; end case rem-status
) ; end let
); end cond has-subrun
(else
+ (BB> "arrived 1")
;; BB - TODO - consider backgrounding to threads to delete tests (work below)
(debug:print-info 0 *default-log-port* "test: " test-name " itest-state: " test-state)
(if (member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ"))
(begin
(if (not (hash-table-ref/default test-retry-time test-fulln #f))
@@ -2230,10 +2237,17 @@
(begin
(runs:remove-test-directory new-test-dat mode) ;; 'remove-all)
(if (not (null? tal))
(loop (car tal)(cdr tal)))))))
(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
+ ((redo-logpro)
+ (BB> "redo-logpro operate-on hook 2")
+ (redo-logpro:redo-logpro run-id test-id new-test-dat)
+ (debug:print-error 0 "redo-logpro unimplemented")
+ (if (not (null? tal))
+ (loop (car tal)(cdr tal)))
+ )
((set-state-status)
(let* ((new-state (car state-status))
(new-status (cadr state-status))
(test-id (db:test-get-id test))
(test-run-dir (db:test-get-rundir new-test-dat))