| ︙ | | | ︙ | |
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
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit runsmod))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses mtargs))
(declare (uses mtver))
(declare (uses csv-xml))
(declare (uses keysmod))
(declare (uses mtmod))
(declare (uses processmod))
(declare (uses dbmod))
(declare (uses rmtmod))
(declare (uses testsmod))
(declare (uses tasksmod))
(declare (uses archivemod))
(declare (uses launchmod))
(declare (uses subrunmod))
(module runsmod
*
(import scheme
(prefix sqlite3 sqlite3:)
chicken.base
|
>
>
>
|
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
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit runsmod))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses mtargs))
(declare (uses mtver))
(declare (uses csv-xml))
(declare (uses keysmod))
(declare (uses mtmod))
(declare (uses processmod))
(declare (uses dbmod))
(declare (uses rmtmod))
(declare (uses testsmod))
(declare (uses tasksmod))
(declare (uses archivemod))
(declare (uses launchmod))
(declare (uses subrunmod))
(declare (uses servermod))
(declare (uses itemsmod))
(module runsmod
*
(import scheme
(prefix sqlite3 sqlite3:)
chicken.base
|
| ︙ | | | ︙ | |
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
dbmod
rmtmod
testsmod
tasksmod
archivemod
launchmod
subrunmod
)
(include "db_records.scm")
;; use this struct to facilitate refactoring
;;
(defstruct runs:dat
reglen regfull
runname max-concurrent-jobs run-id
|
>
>
>
>
>
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
dbmod
rmtmod
testsmod
tasksmod
archivemod
launchmod
subrunmod
servermod
itemsmod
)
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(include "key_records.scm")
;; use this struct to facilitate refactoring
;;
(defstruct runs:dat
reglen regfull
runname max-concurrent-jobs run-id
|
| ︙ | | | ︙ | |
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
|
;;
;; target-patts a1/b1/c1,a2/b2/c2 ...
;;
;; This will fail if called with empty target or a bad target (i.e. missing or extra fields)
;;
(define (runs:get-hash-by-target target-patts runpatt)
(let* ((targets (string-split target-patts ","))
(keys (common:get-fields *configfdat*)) ;; (rmt:get-keys))
(res-ht (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
(for-each
(lambda (target-patt)
(let ((runs (rmt:simple-get-runs runpatt #f #f target-patt #f)))
(for-each
(lambda (run)
(let ((target (simple-run-target run)))
|
|
|
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
|
;;
;; target-patts a1/b1/c1,a2/b2/c2 ...
;;
;; This will fail if called with empty target or a bad target (i.e. missing or extra fields)
;;
(define (runs:get-hash-by-target target-patts runpatt)
(let* ((targets (string-split target-patts ","))
(keys (rmt:get-keys))
(res-ht (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
(for-each
(lambda (target-patt)
(let ((runs (rmt:simple-get-runs runpatt #f #f target-patt #f)))
(for-each
(lambda (run)
(let ((target (simple-run-target run)))
|
| ︙ | | | ︙ | |
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
|
)
)
(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(mode #f)(options '()))
(common:clear-caches) ;; clear all caches
(let* ((db #f)
;; (tdbdat (tasks:open-db))
(keys (common:get-fields *configdat*)) ;; (rmt:get-keys))
(rundat (mt:get-runs-by-patt keys runnamepatt target))
(header (vector-ref rundat 0))
(runs (vector-ref rundat 1))
(states (if state (string-split state ",") '()))
(statuses (if status (string-split status ",") '()))
(state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
(rp-mutex (make-mutex))
|
|
|
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
|
)
)
(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(mode #f)(options '()))
(common:clear-caches) ;; clear all caches
(let* ((db #f)
;; (tdbdat (tasks:open-db))
(keys (rmt:get-keys))
(rundat (mt:get-runs-by-patt keys runnamepatt target))
(header (vector-ref rundat 0))
(runs (vector-ref rundat 1))
(states (if state (string-split state ",") '()))
(statuses (if status (string-split status ",") '()))
(state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
(rp-mutex (make-mutex))
|
| ︙ | | | ︙ | |