Megatest

           (else (car argv))))
         (fullpath (realpath this-script)))
    fullpath))
(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
(define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
(define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))

(define *common:logpro-exit-code->status-sym-alist*
  '( ( 0 . pass )
     ( 1 . fail )
     ( 2 . warn )
     ( 3 . check )
     ( 4 . waived )
     ( 5 . abort )
     ( 6 . skip )))

(define (common:logpro-exit-code->status-sym exit-code)
  (or (alist-ref exit-code *common:logpro-exit-code->status-sym-alist*) 'fail))

(define (common:worse-status-sym ss1 ss2)
  (let loop ((status-syms-remaining '(abort fail check skip warn waived pass)))
    (cond
     ((null? status-syms-remaining)
      'fail)
     ((eq? (car status-syms-remaining) ss1)
      ss1)
     ((eq? (car status-syms-remaining) ss2)
      ss2)
     (else
      (loop (cdr status-syms-remaining))))))

(define (common:steps-can-proceed-given-status-sym status-sym)
  (if (member status-sym '(warn waived pass))
      #t
      #f))

(define (status-sym->string status-sym)
  (case status-sym
      ((pass) "PASS")
    ((fail) "FAIL")
    ((warn) "WARN")
    ((check) "CHECK")
    ((waived) "WAIVED")
    ((abort) "ABORT")
    ((skip) "SKIP")
    (else "FAIL")))

(define (common:logpro-exit-code->test-status exit-code)
  (status-sym->string (common:logpro-exit-code->status-sym exit-code)))

(defstruct remote
  (hh-dat            (common:get-homehost)) ;; homehost record ( addr . hhflag )
  (server-url        (if *toppath* (server:check-if-running *toppath*))) ;; (server:check-if-running *toppath*) #f))
  (last-server-check 0)  ;; last time we checked to see if the server was alive
  (conndat           #f)
  (transport         *transport-type*)

                                         (iup:attribute-set! steps-matrix "BGCOLOR0:7" "149 208 252")
                                         (iup:attribute-set! steps-matrix "0:9" "rerun & continue")
					 (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
					 ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
					 (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
					 (let ((proc
						(lambda (testdat)
						  (dcommon:populate-steps teststeps steps-matrix run-id test-id))))
					   (hash-table-set! widgets "StepsMatrix" proc)
					   (proc testdat))
					 steps-matrix)
				       ;; populate the Test Data panel
				       (iup:frame
					#:title "Test Data"
					(let ((test-data

						 (hash-table-keys tests-info)))))))
     canvas-obj)))

;;======================================================================
;;  S T E P S
;;======================================================================

(define (dcommon:populate-steps teststeps steps-matrix run-id test-id)
  (let* ((max-row       0)
	 (max-col       9)
         (white         "255 255 255")
         
         (testinfo      (rmt:get-testinfo-state-status run-id test-id))
         (state         (db:test-get-state testinfo))
         (status        (db:test-get-status testinfo))
         (test-status-color (car (gutils:get-color-for-state-status state status)))
         (running-color (car (gutils:get-color-for-state-status "RUNNING" "STARTED")))
         (failcolor     (car (gutils:get-color-for-state-status "COMPLETED" "FAIL"))))
    (if (null? teststeps)
	(iup:attribute-set! steps-matrix "CLEARVALUE" "CONTENTS")
	(let loop ((hed    (car teststeps))
		   (tal    (cdr teststeps))
		   (rownum 1)
		   (colnum 1))
	  (if (> rownum max-row)(set! max-row rownum))
	  (let* ((status  (vector-ref hed 3))
                 (val     (vector-ref hed (- colnum 1)))
                 (bgcolor (cond
                           ((member (conc status) '("" "-" "#<unspecified>"))
                            running-color)
                           
                           ((member (conc status) '("0" 0))
                            white)
                           (else test-status-color)))
                          ; (else failcolor)))
		 (mtrx-rc (conc rownum ":" colnum)))
            ;;(print "BB> status=>"status"< bgcolor="bgcolor)
	    (iup:attribute-set! steps-matrix  mtrx-rc (if val (conc val) ""))
            (if (< colnum 5)
                (iup:attribute-set! steps-matrix  (conc "BGCOLOR" mtrx-rc) bgcolor))
	    (if (< colnum max-col)
		(loop hed tal rownum (+ colnum 1))

;;(rmt:get-test-info-by-id run-id test-id) -> testdat



(define (ezsteps:run-from testdat start-step-name run-one)
  ;;# TODO - recapture item variables, debug repeated step eval; regen logpro from test
  (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" '()))
	 (run-mutex     (make-mutex))
	 (rollup-status 0)
         (rollup-status-string #f)
         (rollup-status-sym #f)
	 (exit-info     (vector #t #t #t))
	 (test-id       (db:test-get-id testdat))
	 (run-id        (db:test-get-run_id testdat))
	 (test-name     (db:test-get-testname testdat))
	 (kill-job      #f)) ;; for future use (on re-factoring with launch.scm code

    ;; keep trying till NFS deigns to populate test run dir on this host
    (let loop ((count 5))
      (if (not (common:file-exists? test-run-dir))
	  ;;(push-directory test-run-dir)
	  (if (> count 0)
	      (begin
		(debug:print 0 *default-log-port* "WARNING: ezsteps attempting to run but test run directory " test-run-dir " is not there. Waiting and trying again " count " more times")
		(sleep 3)
		(loop (- count 1))))))
    
    (debug:print-info 0 *default-log-port* "Running in directory " test-run-dir)
    (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))
	(message-window "ERROR: You can only re-run steps defined via ezsteps")
	(begin
	  (let loop ((ezstep   (car ezstepslst))
		     (tal      (cdr ezstepslst))
                     (status-sym-so-far 'pass)
		     ;;(runflag  #f)
                     (saw-start-step-name #f)) ;; flag used to skip steps when not starting at the beginning
	    (if (vector-ref exit-info 1)
		(let* ((stepname    (car ezstep))  ;; do stuff to run the step
                       (logpro-used (common:file-exists? (conc test-run-dir "/" stepname ".logpro")))
		       (stepinfo    (cadr ezstep))
		       (stepparts   (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
		       (stepparms   (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each 
		       (stepcmd     (list-ref stepparts 3))
		       (script      (conc "mt_ezstep '"test-run-dir"' '"stepname"' '"stepcmd"'")) ;; call the command using mt_ezstep

                       (saw-start-step-name-next (or saw-start-step-name (equal? stepname start-step-name)))
                       (proceed-with-this-step
                        (or (not start-step-name)

                            (equal? stepname start-step-name)
                            (and saw-start-step-name (not run-one))
                            saw-start-step-name-next
                            (and start-step-name (equal? stepname start-step-name)))))
                  (cond
                   ((and (not proceed-with-this-step) (null? tal))
                    'done)
                   ((not proceed-with-this-step)
                      (loop (car tal)
                            (cdr tal)
                            status-sym-so-far
                            saw-start-step-name-next))
                   (else
		    (debug:print 4 *default-log-port* "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts
			         " stepparms: " stepparms " stepcmd: " stepcmd)






		    (debug:print 4 *default-log-port* "script: " script)
		    (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f)

		    ;; now launch the script
		    (let ((pid (process-run script)))
		      (let processloop ((i 0))
		        (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
			  (mutex-lock! run-mutex)
			  (vector-set! exit-info 0 pid)
			  (vector-set! exit-info 1 exit-status)
			  (vector-set! exit-info 2 exit-code)
			  (mutex-unlock! run-mutex)
			  (if (eq? pid-val 0)
			      (begin
			        (thread-sleep! 1)
			        (processloop (+ i 1))))
			  ))
		      (let ((exinfo (vector-ref exit-info 2))
			    (logfna (if logpro-used (conc stepname ".html") "")))
		        (rmt:teststep-set-status! run-id test-id stepname "end" exinfo #f logfna))
                      
		      (if logpro-used
			  (rmt:test-set-log! run-id test-id (conc stepname ".html")))
                      
		      ;; set the test final status
		      (let* ((this-step-status      (cond
                                                     (logpro-used
                                                      (common:logpro-exit-code->status-sym (vector-ref exit-info 2)))
					             ((eq? (vector-ref exit-info 2) 0)
                                                      'pass)
					             (else



                                                      'fail)))

			     (overall-status-sym    (common:worse-status-sym this-step-status status-sym-so-far))
                             (overall-status-string (status-sym->string overall-status-sym)))


		        (debug:print 4 *default-log-port* "Exit value received: " (vector-ref exit-info 2) " logpro-used: " logpro-used 
				     " this-step-status: " this-step-status " overall-status: " overall-status-sym) 
		        ;;" next-status: " next-status " rollup-status: " rollup-status)


                        (set! rollup-status-string overall-status-string)







                        (set! rollup-status-sym overall-status-sym)
                        (tests:test-set-status! run-id test-id "RUNNING" overall-status-string #f #f)))

                    (if (and
                         (not run-one)
                         (common:steps-can-proceed-given-status-sym rollup-status-sym)
                         (not (null? tal)))

                        (loop (car tal)
                              (cdr tal)
                              rollup-status-sym
                              saw-start-step-name-next)))))
		(debug:print 4 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep)))
	  
	  ;; Once done with step/steps update the test record
	  ;;
	  (let* ((item-path (db:test-get-item-path testdat)) ;; (item-list->path itemdat))
		 (testinfo  (rmt:get-testinfo-state-status run-id test-id))) ;; refresh the testdat, call it iteminfo in case need prev/curr
	    ;; Am I completed?
	    (if (equal? (db:test-get-state testinfo) "RUNNING") ;; (not (equal? (db:test-get-state testinfo) "COMPLETED"))
		(let ((new-state  (if kill-job "KILLED" "COMPLETED") ;; (if (eq? (vector-ref exit-info 2) 0) ;; exited with "good" status
				  ;; "COMPLETED"
				  ;; (db:test-get-state testinfo)))   ;; else preseve the state as set within the test
				  )
                      (new-status rollup-status-string)








                      ) ;; (db:test-get-status testinfo)))
		  (debug:print-info 2 *default-log-port* "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result, rollup-status is " rollup-status)
		  (tests:test-set-status! run-id test-id 
					  new-state
					  new-status
					  (args:get-arg "-m") #f)
		  ;; need to update the top test record if PASS or FAIL and this is a subtest
		  (if (not (equal? item-path ""))
                      (rmt:set-state-status-and-roll-up-items run-id test-name item-path new-state new-status #f))))
	    ;; 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-string))

(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)))

#     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 <http://www.gnu.org/licenses/>.

usage="mt_ezstep stepname command [args ...]"











# Purpose: This is for the [ezsteps] secton in your testconfig file.
#   DO NOT USE IN YOUR SCRIPTS!
#
# Call like this:
# mt_ezstep stepname prevstepname command ....
# 
if [[ "x$1" == "x" ]];then
  echo "Usage: $usage"
  exit
fi

# Since the user may not have . on the path and since we are likely to want to 
# run test scripts in the current directory add the current dir to the path
export PATH=$PATH:$PWD
testrundir=$1; shift
stepname=$1;shift


command=$*

allstatus=99
runstatus=99
logpropstatus=99

# prev_env=".ezsteps/${prevstepname}.sh"
# echo "prev_env=$prev_env"
# if [[ -e "${prev_env}" ]];then
#     source $prev_env
# fi

# source the environment from the previous step if it exists
cd $testrundir
#if [[ "$MT_CMDINFO" == "" ]];then
  if [[ -e megatest.sh ]];then
    source megatest.sh
  else
    echo "ERROR: $0 should be run within a megatest test environment"
    echo "Usage: $usage"
    exit
  fi
#fi



# if a logpro file exists then use it otherwise just run the command, nb// was using 2>&1
if [[ -e ${stepname}.logpro ]];then









   eval $command 2>&1 ${stepname}.log
   runstatus=$?
   logpro ${stepname}.logpro ${stepname}.html &> /dev/null < ${stepname}.log
   logprostatus=$?





   if [[ $runstatus == 0 ]]; then


       exitstatus=$logprostatus

   else

       exitstatus=$runstatus
   fi
else
   eval $command &> ${stepname}.log
   exitstatus=$?
fi


exit $exitstatus