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
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
|
;;(declare (uses runconfig))
;;(declare (uses tests))
;;(declare (uses server))
;;(declare (uses mt))
;;(declare (uses archive))
;; (declare (uses filedb))
(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")))
(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
(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 runwait "-run-wait " ""))))
cmd))
;; set state/status of test item
;; fork off megatest
;; set state/status of test item
;;
(define (subrun:selector+log-switches 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 `(("-runname" . ,(get-environment-variable "MT_RUNNAME"))
("-target" . ,(get-environment-variable "MT_TARGET"))))
(switch-alist (apply
append
(filter-map (lambda (item)
(let ((config-key (car item))
(switch (cdr item))
(defval (alist-ref defvals switch equal?))
(val (or (configf:lookup subrunconfig switch)
defval)))
(if val
(list switch val)
#f)))
switch-def-alist)))
(target (or (alist-ref "-target" switch-alist equal? #f) ;; want data-structures alist-ref, not alist-lib alist-ref
"NO-TARGET"))
(runname (or (alist-ref "-runname" switch-alist equal? #f)
"NO-RUNNAME"))
(testpatt (alist-ref "-testpatt" switch-alist equal? #f))
(mode-patt (alist-ref "-modepatt" switch-alist equal? #f))
(tag-expr (alist-ref "-tagexpr" switch-alist 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")))
;; note - get precmd from subrun section
;; apply to submegatest commands
(conc
" -start-dir " run-area " "
" -runname " runname " "
" -target " target " "
(if testpatt (conc "-testpatt " testpatt" ") "")
(if modepatt (conc "-modepatt " modepatt" ") "")
(if tag-expr (conc "-tag-expr " tag-expr" ") "")
(string-intersperse
(apply append
(map (lambda (x) (list (car x) (cdr x))) switch-def-alist))
" ")
"-log " logfile)))
(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))
|
|
|
>
>
>
>
>
>
>
>
|
|
|
|
|
>
|
>
>
|
<
<
|
|
|
|
|
|
|
|
|
|
|
<
<
<
|
|
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
<
<
<
<
<
<
<
<
|
|
>
>
>
|
>
|
|
|
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
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
|
;;(declare (uses runconfig))
;;(declare (uses tests))
;;(declare (uses server))
;;(declare (uses mt))
;;(declare (uses archive))
;; (declare (uses filedb))
;(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
;;
(define (subrun:selector+log-switches 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")
"/no/rundir/found"))
("run-name" . ,(or (get-environment-variable "MT_RUNNAME") "NO-RUNNAME"))
("target" . ,(or (get-environment-variable "MT_TARGET") "NO-TARGET"))))
(switch-alist-pre (filter-map (lambda (item)
(let* ((config-key (car item))
(switch (cdr item))
(defval (alist-ref config-key defvals equal? #f))
(val (or (configf:lookup subrunconfig "subrun" config-key)
defval)))
(if val
(cons switch val)
#f)))
switch-def-alist))
;; testpatt may be modified if all three of mode-patt, tag-expr, and testpatt are null
(mode-patt (alist-ref "-modepatt" switch-alist-pre equal? #f))
(tag-expr (alist-ref "-tagexpr" switch-alist-pre equal? #f))
(testpatt (alist-ref "-testpatt" switch-alist-pre equal?
(if (not (or mode-patt tag-expr)) "%" #f))) ;; testpatt is % if not
;; 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)
(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))
|