Megatest

Check-in [86beaad746]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-rerun-logpro
Files: files | file ages | folders
SHA1: 86beaad7468f163c3efd9f7f224e29768bfbbf0e
User & Date: bjbarcla on 2018-12-14 16:38:43
Other Links: branch diff | manifest | tags
Context
2018-12-14
18:01
wip check-in: 99dec402d5 user: bjbarcla tags: v1.65-rerun-logpro
16:38
wip check-in: 86beaad746 user: bjbarcla tags: v1.65-rerun-logpro
2018-12-13
15:50
wip check-in: 386832d442 user: bjbarcla tags: v1.65-rerun-logpro
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified Makefile from [5f2c7e89a3] to [c26d53fdc7].

︙︙
113
114
115
116
117
118
119
120

121
122
123
124
125
126
127

	runconfig.o \
	runs.o \
	server.o \
	tasks.o \
	tdb.o \
	tests.o \
	subrun.o \



tcmt : $(TCMTOBJS) tcmt.scm
	csc $(CSCOPTS) $(TCMTOBJS) tcmt.scm -o tcmt

# install documentation to $(PREFIX)/docs
# DOES NOT REBUILD DOCS
#








|
>








113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

	runconfig.o \
	runs.o \
	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
# DOES NOT REBUILD DOCS
#
︙︙

Modified common.scm from [f3a824a935] to [a785fb6863].

︙︙
82
83
84
85
86
87
88



89
90
91
92
93
94
95

    (length  (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
  )
)


;; GLOBALS




;; CONTEXTS
(defstruct cxt
  (taskdb #f)
  (cmutex (make-mutex)))
;; (define *contexts* (make-hash-table))
;; (define *context-mutex* (make-mutex))









>
>
>








82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

    (length  (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
  )
)


;; 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))
;; (define *context-mutex* (make-mutex))
︙︙

Modified ezsteps.scm from [5d1c395435] to [2c6b60e83e].

︙︙
33
34
35
36
37
38
39
40
41
42




43
44









45
46
47
48
49
50
51
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
87
88
89
90
91
92
93
94
95
96
97
98
99
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223



224
225
226
227
228
229
230

(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:runstep ezstep run-id test-id exit-info m tal testconfig)
  ;; tal - used to detect whether state is COMPLETED (null? tal) is true, or RUNNING
  ;; m - a mutex object




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








|
<
|
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>








33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48
49
50
51
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
87
88
89
90
91
92
93
94
95
96
97
98
99
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245

(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:runstep ezstep run-id test-id exit-info-in in-mutex is-last-step testconfig-in)

  ;; m - a mutex object (why?)
  (let* ((m          (or in-mutex (make-mutex)))
         (exit-info  (or exit-info-in (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
         (testconfig (or testconfig-in (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t)))
         (ezsteplst      (hash-table-ref/default testconfig "ezsteps" '()))
         (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! 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
	           (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-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)) ;; )
︙︙

Modified launch.scm from [5f4f2eac33] to [a27003c329].

︙︙
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

(import (prefix sqlite3 sqlite3:))

(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
;;======================================================================








|








28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

(import (prefix sqlite3 sqlite3:))

(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
;;======================================================================
︙︙
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

(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)
  (let ((cname (conc stepname ".dat")))
    (if (common:file-exists? cname)








|








58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

(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


;; 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)
  (let ((cname (conc stepname ".dat")))
    (if (common:file-exists? cname)
︙︙

Modified redo-logpro.scm from [dcdaae39cb] to [a5ea76c87d].

︙︙
25
26
27
28
29
30
31

32
33
34
35
36

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








>






25
26
27
28
29
30
31
32
33
34
35
36
37

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

This page was generated in about 0.129s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00