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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
;(include "common_records.scm")
;;(include "key_records.scm")
;;(include "db_records.scm")
;;(include "run_records.scm")
;;(include "test_records.scm")
(define (subrun:initialize-toprun-test testconfig test-run-dir)
(let ((ra (configf:lookup testconfig "subrun" "run-area"))
(logpro (configf:lookup testconfig "subrun" "logpro"))
(symlink-target (conc test-run-dir "/subrun-area"))
)
(when (not ra) ;; when runarea is not set we default to *toppath*. However
;; we need to force the setting in the testconfig so it will
;; be preserved in the testconfig.subrun file
(configf:set-section-var testconfig "subrun" "runarea" *toppath*))
(configf:set-section-var testconfig "logpro" "subrun" logpro) ;; append the logpro rules to the logpro section as stepname subrun
(if (common:file-exists? symlink-target)
(delete-file symlink-target))
(create-symbolic-link ra symlink-target)
(configf:write-alist testconfig "testconfig.subrun")))
(define (subrun:launch-cmd test-run-dir)
(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))
;; set state/status of test item
;; fork off megatest
;; set state/status of test item
;;
switches test-run-dir log-prefix)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
<
<
<
<
<
|
|
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
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
|
;(include "common_records.scm")
;;(include "key_records.scm")
;;(include "db_records.scm")
;;(include "run_records.scm")
;;(include "test_records.scm")
(define (subrun:subrun-test-initialized? test-run-dir)
(if (and (common:file-exists? (conc test-run-dir "/subrun-area") )
(common:file-exists? (conc test-run-dir "/testconfig.subrun") ))
#t
#f))
(define (subrun:testconfig-defines-subrun? testconfig)
(configf:lookup testconfig "subrun" "runwait")) ;; we use runwait as the flag that a subrun is requested
(define (subrun:initialize-toprun-test testconfig test-run-dir)
(let ((ra (configf:lookup testconfig "subrun" "run-area"))
(logpro (configf:lookup testconfig "subrun" "logpro"))
(symlink-target (conc test-run-dir "/subrun-area"))
)
(when (not ra) ;; when runarea is not set we default to *toppath*. However
;; we need to force the setting in the testconfig so it will
;; be preserved in the testconfig.subrun file
(configf:set-section-var testconfig "subrun" "runarea" *toppath*))
(configf:set-section-var testconfig "logpro" "subrun" logpro) ;; append the logpro rules to the logpro section as stepname subrun
(if (common:file-exists? symlink-target)
(delete-file symlink-target))
(create-symbolic-link ra symlink-target)
(configf:write-alist testconfig "testconfig.subrun")))
(define (subrun:remove-subrun test-run-dir new-test-dat test-name item-path test-state test-fulln toplevel-with-children test)
;; set state/status of test item
;; fork off megatest
;; set state/status of test item
;;
(let* ((subrun-alist (subrun:selector+log-alist test-run-dir log-prefix))
(runlog (alist-ref "-log" subrun-alist equal? #f)))
(if (not (common:file-exists? runlog))
(BB> "no runlog @ "runlog)
(if (member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ"))
;; This test is not in a correct state for cleaning up. Let's try some graceful shutdown steps first
;; Set the test to "KILLREQ" and wait five seconds then try again. Repeat up to five times then give
;; up and blow it away.
;; call in submegatest:
;; (tasks:kill-runner target run-name testpatt)
(mt:test-set-state-status-by-id run-id (db:test-get-id test) "SUBRUN-KILLREQ" "n/a" #f)
)
;; on success:
;; set state of test, or delete it or whatever
)
)
)
(define (subrun:launch-cmd test-run-dir)
(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:selector+log-alist test-run-dir log-prefix)
(let* ((switch-def-alist (common:get-param-mapping flavor: 'config))
(subrunfile (conc test-run-dir "/testconfig.subrun" ))
(subrundata (with-input-from-file subrunfile read))
(subrunconfig (configf:alist->config subrundata))
(run-area (configf:lookup subrunconfig "subrun" "run-area"))
(defvals `(("start-dir" . ,(or run-area ;; default values if not specified in subrun section of tconf
(get-environment-variable "MT_RUN_AREA_HOME")
|
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
|
(switch-alist (cons
(cons "-log" logfile)
(map (lambda (item)
(if (equal? (car item) "-testpatt")
(cons "-testpatt" testpatt)
item))
switch-alist-pre))))
;; note - get precmd from subrun section
;; apply to submegatest commands
(let* ((res
(string-intersperse
(apply
append
(map
(lambda (x)
(list (car x) (cdr x)))
switch-alist))
" ")))
res)))
(define (subrun:exec-sub-megatest test-run-dir switches #!key (logfile #f))
(let* ((real-logfile (or logfile (conc (test-run-dir) "/subrun-"
(string-substitute "[/*]" "_" (string-intersperse switches "^"))"-"
(number->string (current-seconds)) ".log")))
(selector-switches (common:sub-megatest-selector-switches test-run-dir))
(cmd-list `("megatest" ,@selector-switches ,@switches "-log" ,real-logfile))
|
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
<
|
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
|
(switch-alist (cons
(cons "-log" logfile)
(map (lambda (item)
(if (equal? (car item) "-testpatt")
(cons "-testpatt" testpatt)
item))
switch-alist-pre))))
switch-alist))
;; note - get precmd from subrun section
;; apply to submegatest commands
(define (subrun:get-log-path test-run-dir log-prefix)
(let* ((alist (subrun:selector+log-alist test-run-dir log-prefix))
(res (alist-ref "-log" alist equal? #f)))
res))
(define (subrun:selector+log-switches test-run-dir log-prefix)
(let* ((switch-alist (subrun:selector+log-alist test-run-dir log-prefix))
(res
(string-intersperse
(apply
append
(map
(lambda (x)
(list (car x) (cdr x)))
switch-alist))
" ")))
res))
(define (subrun:exec-sub-megatest test-run-dir switches #!key (logfile #f))
(let* ((real-logfile (or logfile (conc (test-run-dir) "/subrun-"
(string-substitute "[/*]" "_" (string-intersperse switches "^"))"-"
(number->string (current-seconds)) ".log")))
(selector-switches (common:sub-megatest-selector-switches test-run-dir))
(cmd-list `("megatest" ,@selector-switches ,@switches "-log" ,real-logfile))
|