Megatest

Diff
Login

Differences From Artifact [aab87817a5]:

To Artifact [f2352857f1]:


15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31









32
33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
15
16
17
18
19
20
21



22
23
24
25
26
27
28
29
30
31
32
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







-
-
-



+




+
+
+
+
+
+
+
+
+











-
+







;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use srfi-1 posix regex srfi-69 directory-utils call-with-environment-variables posix-extras
     z3 csv typed-records pathname-expand matchable)

(declare (unit ezsteps))
(declare (uses db))
(declare (uses common))
(declare (uses debugprint))
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses commonmod))
(declare (uses mtargs))

(use srfi-1 posix regex srfi-69 directory-utils call-with-environment-variables posix-extras
     z3 csv typed-records pathname-expand matchable)

(import commonmod
	debugprint
	(prefix mtargs args:))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")


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

;; TODO: deprecate me in favor of ezsteps.scm
;;
(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat)
(define (ezsteps:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat)
  (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))
61
62
63
64
65
66
67
68


69
70
71
72
73
74
75
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83







-
+
+







			     (list-ref stepparts 3)
			     (conc "# error, no command for step "stepname)))
	 (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)))
	 (logpro-used    (common:file-exists? logpro-file))
	 (mtexepath      (common:get-megatest-exe-path)))
    (setenv "MT_STEP_NAME" stepname)
    (hash-table-set! all-steps-dat stepname `((params . ,paramparts)))
    (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
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116







-
+







    ;; 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") ":.")))
     (list (cons "PATH" mtexepath))
     (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