| ︙ | | |
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
+
+
|
(declare (uses dbfile))
(declare (uses envmod))
(declare (uses apimod))
(declare (uses genexample))
(declare (uses rmtmod))
(declare (uses archivemod))
(declare (uses mutils))
(declare (uses odsmod))
(declare (uses testsmod))
(use srfi-69)
(module mtbody
*
(import scheme)
|
| ︙ | | |
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
-
|
srfi-1
srfi-18
srfi-69
typed-records
system-information
debugprint
mutils
|
| ︙ | | |
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
+
+
+
|
runsmod
rmtmod
launchmod
fsmod
envmod
apimod
genexample
mutils
odsmod
testsmod
)
(include "common_records.scm")
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
;; (include "common_records.scm")
|
| ︙ | | |
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
|
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
|
-
+
|
1)))
(runs:run-tests target
runname
#f ;; (common:args-get-testpatt #f)
;; (or (args:get-arg "-testpatt")
;; "%")
user
(current-user-name)
args:arg-hash
run-count: rerun-cnt)))
;; get lock in db for full run for this directory
;; for all tests with deps
;; walk tree of tests to find head tasks
;; add head tasks to task queue
|
| ︙ | | |
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
|
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
|
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
|
;; == duplicated == user
;; == duplicated == args:arg-hash))))
;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
(general-run-call
"-rollup"
"rollup tests"
(lambda (target runname keys keyvals)
(runs:rollup-run keys
keyvals
(or (args:get-arg "-runname")(args:get-arg ":runname") )
user))))
;; (if (args:get-arg "-rollup")
;; (general-run-call
;; "-rollup"
;; "rollup tests"
;; (lambda (target runname keys keyvals)
;; (runs:rollup-run keys
;; keyvals
;; (or (args:get-arg "-runname")(args:get-arg ":runname") )
;; user))))
;;======================================================================
;; Lock or unlock a run
;;======================================================================
(if (or (args:get-arg "-lock")(args:get-arg "-unlock"))
(general-run-call
|
| ︙ | | |