| ︙ | | | ︙ | |
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses rmtmod))
(use srfi-69)
(module tasksmod
*
(import scheme)
|
>
>
>
>
>
|
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses rmtmod))
(declare (uses servermod))
(declare (uses processmod))
(declare (uses pgdb))
(declare (uses mtmod))
(declare (uses megatestmod))
(use srfi-69)
(module tasksmod
*
(import scheme)
|
| ︙ | | | ︙ | |
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
regex-case
sparse-vectors
)
(use srfi-69))
(chicken-5
(import (prefix sqlite3 sqlite3:)
;; data-structures
;; extras
;; files
;; posix
;; posix-extras
|
<
<
<
<
<
|
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
regex-case
sparse-vectors
)
(use srfi-69))
(chicken-5
(import (prefix sqlite3 sqlite3:)
chicken.base
chicken.condition
chicken.file
chicken.file.posix
chicken.io
chicken.pathname
chicken.port
|
| ︙ | | | ︙ | |
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
srfi-69
typed-records
(prefix base64 base64:)
(prefix sqlite3 sqlite3:)
md5
message-digest
z3
debugprint
commonmod
configfmod
(prefix mtargs args:)
dbmod
dbfile
rmtmod
)
(include "task_records.scm")
(include "db_records.scm")
;;======================================================================
;; Tasks db
|
>
>
>
>
>
>
|
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
|
srfi-69
typed-records
(prefix base64 base64:)
(prefix sqlite3 sqlite3:)
md5
message-digest
z3
directory-utils
debugprint
commonmod
configfmod
(prefix mtargs args:)
dbmod
dbfile
rmtmod
servermod
processmod
pgdb
mtmod
megatestmod
)
(include "task_records.scm")
(include "db_records.scm")
;;======================================================================
;; Tasks db
|
| ︙ | | | ︙ | |
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
|
(if (null? tal)
#t
(loop (car tal)(cdr tal)))
#f))))))
(pop-directory)
result)))))
;; if .testconfig exists in test directory read and return it
;; else if have cached copy in *testconfigs* return it IFF there is a section "have fulldata"
;; else read the testconfig file
;; if have path to test directory save the config as .testconfig and return it
;;
(define (tests:get-testconfig test-name item-path test-registry system-allowed #!key (force-create #f)(allow-write-cache #t)(wait-a-minute #f))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
|
(if (null? tal)
#t
(loop (car tal)(cdr tal)))
#f))))))
(pop-directory)
result)))))
(define (tests:get-test-path-from-environment)
(if (and (getenv "MT_LINKTREE")
(getenv "MT_TARGET")
(getenv "MT_RUNNAME")
(getenv "MT_TEST_NAME")
(getenv "MT_ITEMPATH"))
(conc (getenv "MT_LINKTREE") "/"
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME")
(if (and (getenv "MT_ITEMPATH")
(not (string=? "" (getenv "MT_ITEMPATH"))))
(conc "/" (getenv "MT_ITEMPATH"))
""))
#f))
;; if .testconfig exists in test directory read and return it
;; else if have cached copy in *testconfigs* return it IFF there is a section "have fulldata"
;; else read the testconfig file
;; if have path to test directory save the config as .testconfig and return it
;;
(define (tests:get-testconfig test-name item-path test-registry system-allowed #!key (force-create #f)(allow-write-cache #t)(wait-a-minute #f))
|
| ︙ | | | ︙ | |