9
10
11
12
13
14
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
|
9
10
11
12
13
14
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
58
59
|
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+
-
+
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
|
;; PURPOSE.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format)
(declare (unit subrun))
(declare (uses runs))
(declare (uses db))
;;(declare (uses runs))
;;(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses mt))
(declare (uses archive))
;;(declare (uses items))
;;(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")
;;(include "key_records.scm")
;;(include "db_records.scm")
;;(include "run_records.scm")
;;(include "test_records.scm")
(define (subrun:initialize-toprun-test test-run-dir testconfig)
(let ((ra (configf:lookup testconfig "subrun" "run-area")))
(when (not ra) ;; when runarea is not set we default to *toppath*. However
(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 "subrun" "runarea" *toppath*))
)
(configf:write-alist testconfig "testconfig.subrun")
)
(define (subrun:launch )
)
(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
;;
|
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
|
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
|
-
+
-
+
-
-
-
+
+
+
+
+
+
+
+
|
(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 switch-alist "-target" equal?)
(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 switch-alist "-runname" equal?)
(runname (or (alist-ref "-runname" switch-alist equal? #f)
"NO-RUNNAME"))
(testpatt (alist-ref switch-alist "-testpatt" equal?))
(mode-patt (alist-ref switch-alist "-modepatt" equal?))
(tag-expr (alist-ref switch-alist "-tagexpr" equal?))
(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)))
|