83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
(create-symbolic-link ra symlink-target)
(configf:write-alist testconfig "testconfig.subrun")))
(define (subrun:set-state-status test-run-dir state status new-state-status)
(if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir))
(let* ((action-switches-str
(conc "-set-state-status "new-state-status
(if state (conc " -state "state) "")
(if status (conc " -status "status) "")))
(log-prefix (conc "set-state-status="new-state-status
(if state (conc ":state="state) "")
(if status (conc "+status="status) "")))
(submt-result
(subrun:exec-sub-megatest test-run-dir action-switches-str log-prefix)))
submt-result)))
(define (subrun:remove-subrun test-run-dir keep-records )
(if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir))
(let* ((action-switches-str
|
|
<
<
<
|
|
|
|
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(create-symbolic-link ra symlink-target)
(configf:write-alist testconfig "testconfig.subrun")))
(define (subrun:set-state-status test-run-dir state status new-state-status)
(if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir))
(let* ((log-prefix (subrun:sanitize-path
(conc "set-state-status="new-state-status
(if state (conc ":state="(state) "")
(if status (conc "+status="status) "")))))
(submt-result
(subrun:exec-sub-megatest test-run-dir action-switches-str log-prefix)))
submt-result)))
(define (subrun:remove-subrun test-run-dir keep-records )
(if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir))
(let* ((action-switches-str
|
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
(let* ((log-prefix "run")
(switches (subrun:selector+log-switches test-run-dir log-prefix))
(run-wait #t)
(cmd (conc "megatest -run "switches" "
(if run-wait "-run-wait " ""))))
cmd))
(define (subrun:get-runarea test-run-dir)
(if (subrun:subrun-test-initialized? test-run-dir)
(let* ((info-alist (subrun:selector+log-alist
test-run-dir
"foo"))
(run-area (if (list? info-alist)
|
>
>
>
>
>
>
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
(let* ((log-prefix "run")
(switches (subrun:selector+log-switches test-run-dir log-prefix))
(run-wait #t)
(cmd (conc "megatest -run "switches" "
(if run-wait "-run-wait " ""))))
cmd))
(define (subrun:sanitize-path inpath)
(let* ((insane-pattern (irregex "[^[a-zA-Z0-9_\\-]")))
(regex#string-substitute insane-pattern "_" inpath #t)))
(subrun:sanitize-path "a/b/c-d/e*f")
(define (subrun:get-runarea test-run-dir)
(if (subrun:subrun-test-initialized? test-run-dir)
(let* ((info-alist (subrun:selector+log-alist
test-run-dir
"foo"))
(run-area (if (list? info-alist)
|
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
;; otherwise specified
;; define compact-stem for logfile
(target (alist-ref "-target" switch-alist-pre equal? #f)) ;; want data-structures alist-ref, not alist-lib alist-ref
(runname (alist-ref "-runname" switch-alist-pre equal? #f))
(compact-stem (string-substitute "[/*]" "_"
(conc
target
"-"
runname
"-" (or testpatt mode-patt tag-expr "NO-TESTPATT"))))
(logfile (conc
test-run-dir "/"
(or log-prefix "")
(if log-prefix "-" "")
compact-stem
".log"))
;; swap out testpatt with modified test-patt and add -log
(switch-alist (cons
(cons "-log" logfile)
(map (lambda (item)
|
|
|
|
|
|
|
|
|
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
;; otherwise specified
;; define compact-stem for logfile
(target (alist-ref "-target" switch-alist-pre equal? #f)) ;; want data-structures alist-ref, not alist-lib alist-ref
(runname (alist-ref "-runname" switch-alist-pre equal? #f))
(compact-stem (subrun:sanitize-path
(conc
target
"-"
runname
"-" (or testpatt mode-patt tag-expr "NO-TESTPATT"))))
(logfile (conc
test-run-dir "/"
(or (subrun:sanitize-path log-prefix) "")
(if log-prefix "-" "")
compact-stem
".log"))
;; swap out testpatt with modified test-patt and add -log
(switch-alist (cons
(cons "-log" logfile)
(map (lambda (item)
|