Modified apimod.scm
from [1230728213]
to [49fb14301c].
︙ | | |
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
-
+
+
+
|
(declare (uses debugprint))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tcp-transportmod))
(declare (uses megatestmod))
(module apimod
()
(
api:dispatch-request
)
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix matchable typed-records srfi-1 srfi-18 srfi-69 )
(import commonmod)
(import debugprint)
(import dbmod)
(import dbfile)
|
︙ | | |
Modified archivemod.scm
from [84501e50bf]
to [5b21746964].
︙ | | |
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
+
+
+
+
+
+
-
+
+
+
|
(declare (uses mtmod))
(declare (uses dbmod))
(declare (uses dbfile))
(use srfi-69)
(module archivemod
(
archive:get-archive-disks
archive:allocate-new-archive-block
archive:get-timestamp-dir
archive:megatest-db
archive:bup-get-data
()
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
ports
|
︙ | | |
Modified commonmod.scm
from [4d77696a14]
to [383f62c6d4].
︙ | | |
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
|
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
z3)
(import stml2
)
(module commonmod
(
keys->valslots
item-list->path
common:human-time
number-of-processes-running
get-normalized-cpu-load
common:find-local-megatest
common:get-intercept
common:get-num-cpus
common:get-cpu-load
common:hms-string->seconds
seconds->time-string
common:get-megatest-exe
megatest-version
common:get-toppath
common:generic-ssh
common:file-exists?
common:with-env-vars
common:nice-path
common:get-fields
common:get-normalized-cpu-load
common:unix-ping
common:get-normalized-cpu-load
;; globals
*common:badly-ended-states*
*common:dont-roll-up-states*
*common:ended-states*
*common:not-started-ok-statuses*
*common:running-states*
*common:std-states*
*common:std-statuses*
*common:well-ended-states*
*configdat*
*configinfo*
*db-access-allowed*
*db-api-call-time*
*db-cache-path*
*db-keys*
*default-area-tag*
*host-loads*
*keyvals*
*logged-in-clients*
*my-client-signature*
*on-exit-procs*
*pkts-info*
*pre-reqs-met-cache*
*runremote*
*server-id*
*server-info*
*target*
*task-db*
*testconfigs*
*time-to-exit*
*toppath*
*transport-type*
any->number-if-possible
common:special-sort
keys:target-set-args
getenv
setenv
safe-setenv
commonmod:get-cpu-load
get-area-path-signature
common:simple-file-lock
common:low-noise-print
common:get-create-writeable-dir
common:real-path
val->alist
client:get-signature
common:get-color-from-status
seconds->year-work-week/day-time
common:simple-file-release-lock
common:simple-file-lock-and-wait
tests:lookup-itemmap
tests:match->sqlqry
runs:get-std-run-fields
common:min-max
common:max
common:sum
keys:target->keyval
db:patt->like
rmt:transport-mode
common:version-signature
keys->keystr
keys:config-get-fields
common:make-tmpdir-name
db:test-get-status
db:test-get-state
db:test-get-event_time
db:test-get-item-path
db:test-get-testname
db:test-get-id
db:test-get-comment
db:test-get-run_duration
db:test-get-rundir
tests:match
patt-list-match
common:pkts-spec
sdb:qry
seconds->work-week/day-time
tdb:step-get-comment
seconds->hr-min-sec
any->number
tdb:step-get-logfile
tdb:step-get-event_time
tdb:step-get-status
tdb:step-get-state
tdb:step-get-id
tdb:step-get-stepname
db:test-make-full-name
common:htree->html
common:list->htree
tdb:steps-table-get-log-file
tdb:steps-table-get-runtime
tdb:steps-table-get-status
tdb:steps-table-get-end
tdb:steps-table-get-start
tdb:steps-table-get-stepname
tdb:step-get-last_update
tdb:step-get-test_id
db:test-get-run_id
db:test-get-final_logf
tests:testqueue-get-item_path
tests:testqueue-get-itemdat
tests:testqueue-get-testname
tests:testqueue-get-priority
tests:testqueue-set-priority!
tests:testqueue-get-testconfig
tests:testqueue-get-waitons
tasks:wait-on-journal
common:get-area-path-signature
db:test-get-last_update
db:test-get-archived
db:test-get-uname
db:test-get-diskfree
db:test-get-cpuload
db:test-get-process_id
db:test-get-host
db:test-data-get-last_update
db:test-data-get-type
db:test-data-get-status
db:test-data-get-comment
db:test-data-get-units
db:test-data-get-tol
db:test-data-get-expected
db:test-data-get-value
db:test-data-get-variable
db:test-data-get-category
db:test-data-get-test_id
db:test-data-get-id
host-last-cpuload
host-last-update
host-last-cpuload-set!
host-last-update-set!
host-reachable-set!
make-host
host-last-used-set!
host-reachable
host-last-used
common:alist-ref/default
common:val->alist
common:in-running-test?
common:without-vars
common:get-megatest-exe-path
common:get-megatest-exe-dir
common:get-param-mapping
common:get-mtexe
db:test-get-is-toplevel
seconds->quarter
*globalexitstatus*
tests:testqueue-set-items!
tests:testqueue-get-items
*runconfigdat*
*passnum*
*already-seen-runconfig-info*
common:directory-writable?
common:dir-clean-up
common:fail-safe
common:list-or-null
*toptest-paths*
common:directory-exists?
*configstatus*
*last-launch*
*launch-setup-mutex*
commonmod:is-test-alive
alist->env-vars
*env-vars-by-run-id*
common:get-signature
common:join-backgrounded-threads
tests:glob-like-match
common:send-thunk-to-background-thread
db:test-get-fullname
common:clear-caches
db:mintest-get-event_time
*test-meta-updated*
tests:testqueue-set-item_path!
tests:testqueue-set-itemdat!
make-tests:testqueue
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
|
︙ | | |
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
|
+
+
|
srfi-1
srfi-18
srfi-69
typed-records
system-information
debugprint
megatest-fossil-hash
)))
;;======================================================================
;; CONTENTS
;;
;; config file utils
;; misc conversion, data manipulation functions
|
︙ | | |
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
|
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(define (common:get-fields cfgdat)
(let ((fields (hash-table-ref/default cfgdat "fields" '())))
(map car fields)))
(define keys:config-get-fields common:get-fields)
;;======================================================================
;; db_records.scm
;;======================================================================
;;======================================================================
;; dbstruct
;;======================================================================
(define (make-db:test)(make-vector 20))
(define (db:test-get-id vec) (vector-ref vec 0))
(define (db:test-get-run_id vec) (vector-ref vec 1))
(define (db:test-get-testname vec) (vector-ref vec 2))
(define (db:test-get-state vec) (vector-ref vec 3))
(define (db:test-get-status vec) (vector-ref vec 4))
(define (db:test-get-event_time vec) (vector-ref vec 5))
(define (db:test-get-host vec) (vector-ref vec 6))
(define (db:test-get-cpuload vec) (vector-ref vec 7))
(define (db:test-get-diskfree vec) (vector-ref vec 8))
(define (db:test-get-uname vec) (vector-ref vec 9))
;; (define (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10)))
(define (db:test-get-rundir vec) (vector-ref vec 10))
(define (db:test-get-item-path vec) (vector-ref vec 11))
(define (db:test-get-run_duration vec) (vector-ref vec 12))
(define (db:test-get-final_logf vec) (vector-ref vec 13))
(define (db:test-get-comment vec) (vector-ref vec 14))
(define (db:test-get-process_id vec) (vector-ref vec 16))
(define (db:test-get-archived vec) (vector-ref vec 17))
(define (db:test-get-last_update vec) (vector-ref vec 18))
)
;; (define (db:test-get-pass_count vec) (vector-ref vec 15))
;; (define (db:test-get-fail_count vec) (vector-ref vec 16))
(define (db:test-get-fullname vec)
(conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
;; replace runs:make-full-test-name with this routine
(define (db:test-make-full-name testname itempath)
(if (equal? itempath "") testname (conc testname "/" itempath)))
;; (define (db:test-get-first_err vec) (printable (vector-ref vec 15)))
;; (define (db:test-get-first_warn vec) (printable (vector-ref vec 16))) ;; RADT => reference 16 is repeated
(define (db:test-set-cpuload! vec val)(vector-set! vec 7 val))
(define (db:test-set-diskfree! vec val)(vector-set! vec 8 val))
(define (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define (db:test-set-state! vec val)(vector-set! vec 3 val))
(define (db:test-set-status! vec val)(vector-set! vec 4 val))
(define (db:test-set-run_duration! vec val)(vector-set! vec 12 val))
(define (db:test-set-final_logf! vec val)(vector-set! vec 13 val))
;; Test record utility functions
;; Is a test a toplevel?
;;
(define (db:test-get-is-toplevel vec)
(and (equal? (db:test-get-item-path vec) "") ;; test is not an item
(equal? (db:test-get-uname vec) "n/a"))) ;; test has never been run
;; make-vector-record "" db mintest id run_id testname state status event_time item_path
;; RADT => purpose of mintest??
;;
(define (make-db:mintest)(make-vector 7))
(define (db:mintest-get-id vec) (vector-ref vec 0))
(define (db:mintest-get-run_id vec) (vector-ref vec 1))
(define (db:mintest-get-testname vec) (vector-ref vec 2))
(define (db:mintest-get-state vec) (vector-ref vec 3))
(define (db:mintest-get-status vec) (vector-ref vec 4))
(define (db:mintest-get-event_time vec) (vector-ref vec 5))
(define (db:mintest-get-item_path vec) (vector-ref vec 6))
;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk
(define (make-db:testmeta)(make-vector 10 ""))
(define (db:testmeta-get-id vec) (vector-ref vec 0))
(define (db:testmeta-get-testname vec) (vector-ref vec 1))
(define (db:testmeta-get-author vec) (vector-ref vec 2))
(define (db:testmeta-get-owner vec) (vector-ref vec 3))
(define (db:testmeta-get-description vec) (vector-ref vec 4))
(define (db:testmeta-get-reviewed vec) (vector-ref vec 5))
(define (db:testmeta-get-iterated vec) (vector-ref vec 6))
(define (db:testmeta-get-avg_runtime vec) (vector-ref vec 7))
(define (db:testmeta-get-avg_disk vec) (vector-ref vec 8))
(define (db:testmeta-get-tags vec) (vector-ref vec 9))
(define (db:testmeta-set-id! vec val)(vector-set! vec 0 val))
(define (db:testmeta-set-testname! vec val)(vector-set! vec 1 val))
(define (db:testmeta-set-author! vec val)(vector-set! vec 2 val))
(define (db:testmeta-set-owner! vec val)(vector-set! vec 3 val))
(define (db:testmeta-set-description! vec val)(vector-set! vec 4 val))
(define (db:testmeta-set-reviewed! vec val)(vector-set! vec 5 val))
(define (db:testmeta-set-iterated! vec val)(vector-set! vec 6 val))
(define (db:testmeta-set-avg_runtime! vec val)(vector-set! vec 7 val))
(define (db:testmeta-set-avg_disk! vec val)(vector-set! vec 8 val))
;;======================================================================
;; S I M P L E R U N
;;======================================================================
;; (defstruct id "runname" "state" "status" "owner" "event_time"
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (make-db:test-data)(make-vector 10))
(define (db:test-data-get-id vec) (vector-ref vec 0))
(define (db:test-data-get-test_id vec) (vector-ref vec 1))
(define (db:test-data-get-category vec) (vector-ref vec 2))
(define (db:test-data-get-variable vec) (vector-ref vec 3))
(define (db:test-data-get-value vec) (vector-ref vec 4))
(define (db:test-data-get-expected vec) (vector-ref vec 5))
(define (db:test-data-get-tol vec) (vector-ref vec 6))
(define (db:test-data-get-units vec) (vector-ref vec 7))
(define (db:test-data-get-comment vec) (vector-ref vec 8))
(define (db:test-data-get-status vec) (vector-ref vec 9))
(define (db:test-data-get-type vec) (vector-ref vec 10))
(define (db:test-data-get-last_update vec) (vector-ref vec 11))
(define (db:test-data-set-id! vec val)(vector-set! vec 0 val))
(define (db:test-data-set-test_id! vec val)(vector-set! vec 1 val))
(define (db:test-data-set-category! vec val)(vector-set! vec 2 val))
(define (db:test-data-set-variable! vec val)(vector-set! vec 3 val))
(define (db:test-data-set-value! vec val)(vector-set! vec 4 val))
(define (db:test-data-set-expected! vec val)(vector-set! vec 5 val))
(define (db:test-data-set-tol! vec val)(vector-set! vec 6 val))
(define (db:test-data-set-units! vec val)(vector-set! vec 7 val))
(define (db:test-data-set-comment! vec val)(vector-set! vec 8 val))
(define (db:test-data-set-status! vec val)(vector-set! vec 9 val))
(define (db:test-data-set-type! vec val)(vector-set! vec 10 val))
;;======================================================================
;; S T E P S
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time
(define (make-db:step)(make-vector 9))
(define (tdb:step-get-id vec) (vector-ref vec 0))
(define (tdb:step-get-test_id vec) (vector-ref vec 1))
(define (tdb:step-get-stepname vec) (vector-ref vec 2))
(define (tdb:step-get-state vec) (vector-ref vec 3))
(define (tdb:step-get-status vec) (vector-ref vec 4))
(define (tdb:step-get-event_time vec) (vector-ref vec 5))
(define (tdb:step-get-logfile vec) (vector-ref vec 6))
(define (tdb:step-get-comment vec) (vector-ref vec 7))
(define (tdb:step-get-last_update vec) (vector-ref vec 8))
(define (tdb:step-set-id! vec val)(vector-set! vec 0 val))
(define (tdb:step-set-test_id! vec val)(vector-set! vec 1 val))
(define (tdb:step-set-stepname! vec val)(vector-set! vec 2 val))
(define (tdb:step-set-state! vec val)(vector-set! vec 3 val))
(define (tdb:step-set-status! vec val)(vector-set! vec 4 val))
(define (tdb:step-set-event_time! vec val)(vector-set! vec 5 val))
(define (tdb:step-set-logfile! vec val)(vector-set! vec 6 val))
(define (tdb:step-set-comment! vec val)(vector-set! vec 7 val))
;; The steps table
(define (make-db:steps-table)(make-vector 5))
(define (tdb:steps-table-get-stepname vec) (vector-ref vec 0))
(define (tdb:steps-table-get-start vec) (vector-ref vec 1))
(define (tdb:steps-table-get-end vec) (vector-ref vec 2))
(define (tdb:steps-table-get-status vec) (vector-ref vec 3))
(define (tdb:steps-table-get-runtime vec) (vector-ref vec 4))
(define (tdb:steps-table-get-log-file vec) (vector-ref vec 5))
(define (tdb:step-stable-set-stepname! vec val)(vector-set! vec 0 val))
(define (tdb:step-stable-set-start! vec val)(vector-set! vec 1 val))
(define (tdb:step-stable-set-end! vec val)(vector-set! vec 2 val))
(define (tdb:step-stable-set-status! vec val)(vector-set! vec 3 val))
(define (tdb:step-stable-set-runtime! vec val)(vector-set! vec 4 val))
;; ;; The data structure for handing off requests via wire
;; (define (make-cdb:packet)(make-vector 6))
;; (define (cdb:packet-get-client-sig vec) (vector-ref vec 0))
;; (define (cdb:packet-get-qtype vec) (vector-ref vec 1))
;; (define (cdb:packet-get-immediate vec) (vector-ref vec 2))
;; (define (cdb:packet-get-query-sig vec) (vector-ref vec 3))
;; (define (cdb:packet-get-params vec) (vector-ref vec 4))
;; (define (cdb:packet-get-qtime vec) (vector-ref vec 5))
;; (define (cdb:packet-set-client-sig! vec val)(vector-set! vec 0 val))
;; (define (cdb:packet-set-qtype! vec val)(vector-set! vec 1 val))
;; (define (cdb:packet-set-immediate! vec val)(vector-set! vec 2 val))
;; (define (cdb:packet-set-query-sig! vec val)(vector-set! vec 3 val))
;; (define (cdb:packet-set-params! vec val)(vector-set! vec 4 val))
;; (define (cdb:packet-set-qtime! vec val)(vector-set! vec 5 val))
;;======================================================================
;; key_records
;;======================================================================
(define (keys->valslots keys) ;; => ?,?,? ....
(string-intersperse (map (lambda (x) "?") keys) ","))
;; (define (keys->key/field keys . additional)
;; (string-join (map (lambda (k)(conc k " TEXT"))
;; (append keys additional)) ","))
(define (item-list->path itemdat)
(if (list? itemdat)
(string-intersperse (map cadr itemdat) "/")
""))
;;======================================================================
;; test_records
;;======================================================================
;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
(define (tests:testqueue-get-testname vec) (vector-ref vec 0))
(define (tests:testqueue-get-testconfig vec) (vector-ref vec 1))
(define (tests:testqueue-get-waitons vec) (vector-ref vec 2))
(define (tests:testqueue-get-priority vec) (vector-ref vec 3))
;; items: #f=no items, list=list of items remaining, proc=need to call to get items
(define (tests:testqueue-get-items vec) (vector-ref vec 4))
(define (tests:testqueue-get-itemdat vec) (vector-ref vec 5))
(define (tests:testqueue-get-item_path vec) (vector-ref vec 6))
(define (tests:testqueue-set-testname! vec val)(vector-set! vec 0 val))
(define (tests:testqueue-set-testconfig! vec val)(vector-set! vec 1 val))
(define (tests:testqueue-set-waitons! vec val)(vector-set! vec 2 val))
(define (tests:testqueue-set-priority! vec val)(vector-set! vec 3 val))
(define (tests:testqueue-set-items! vec val)(vector-set! vec 4 val))
(define (tests:testqueue-set-itemdat! vec val)(vector-set! vec 5 val))
(define (tests:testqueue-set-item_path! vec val)(vector-set! vec 6 val))
)
|
Modified configfmod.scm
from [2804d0750e]
to [deed360501].
︙ | | |
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
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
|
+
+
+
+
+
+
+
+
-
+
+
+
+
|
(module configfmod
(
lookup
configf:lookup
get-section
configf:get-section
configf:lookup-number
read-config
runconfigs-get
configf:section-vars
configf:read-alist
configf:config->alist
configf:alist->config
configf:set-section-var
)
find-and-read-config
common:args-get-target
)
(import scheme
chicken
extras
files
matchable
ports
|
︙ | | |
Modified dashboard.scm
from [e6df99a16d]
to [e0e854db49].
︙ | | |
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
-
+
|
testsmod
)
;; (include "common_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "dashboard-transport-mode.scm")
|
︙ | | |
Modified db_records.scm
from [d1dae58171]
to [1501321c72].
︙ | | |
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
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
11
12
13
14
15
16
17
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;; dbstruct
;;======================================================================
(define (make-db:test)(make-vector 20))
(define (db:test-get-id vec) (vector-ref vec 0))
(define (db:test-get-run_id vec) (vector-ref vec 1))
(define (db:test-get-testname vec) (vector-ref vec 2))
(define (db:test-get-state vec) (vector-ref vec 3))
(define (db:test-get-status vec) (vector-ref vec 4))
(define (db:test-get-event_time vec) (vector-ref vec 5))
(define (db:test-get-host vec) (vector-ref vec 6))
(define (db:test-get-cpuload vec) (vector-ref vec 7))
(define (db:test-get-diskfree vec) (vector-ref vec 8))
(define (db:test-get-uname vec) (vector-ref vec 9))
;; (define (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10)))
(define (db:test-get-rundir vec) (vector-ref vec 10))
(define (db:test-get-item-path vec) (vector-ref vec 11))
(define (db:test-get-run_duration vec) (vector-ref vec 12))
(define (db:test-get-final_logf vec) (vector-ref vec 13))
(define (db:test-get-comment vec) (vector-ref vec 14))
(define (db:test-get-process_id vec) (vector-ref vec 16))
(define (db:test-get-archived vec) (vector-ref vec 17))
(define (db:test-get-last_update vec) (vector-ref vec 18))
;; (define (db:test-get-pass_count vec) (vector-ref vec 15))
;; (define (db:test-get-fail_count vec) (vector-ref vec 16))
(define (db:test-get-fullname vec)
(conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
;; replace runs:make-full-test-name with this routine
(define (db:test-make-full-name testname itempath)
(if (equal? itempath "") testname (conc testname "/" itempath)))
;; (define (db:test-get-first_err vec) (printable (vector-ref vec 15)))
;; (define (db:test-get-first_warn vec) (printable (vector-ref vec 16))) ;; RADT => reference 16 is repeated
(define (db:test-set-cpuload! vec val)(vector-set! vec 7 val))
(define (db:test-set-diskfree! vec val)(vector-set! vec 8 val))
(define (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define (db:test-set-state! vec val)(vector-set! vec 3 val))
(define (db:test-set-status! vec val)(vector-set! vec 4 val))
(define (db:test-set-run_duration! vec val)(vector-set! vec 12 val))
(define (db:test-set-final_logf! vec val)(vector-set! vec 13 val))
;; Test record utility functions
;; Is a test a toplevel?
;;
(define (db:test-get-is-toplevel vec)
(and (equal? (db:test-get-item-path vec) "") ;; test is not an item
(equal? (db:test-get-uname vec) "n/a"))) ;; test has never been run
;; make-vector-record "" db mintest id run_id testname state status event_time item_path
;; RADT => purpose of mintest??
;;
(define (make-db:mintest)(make-vector 7))
(define (db:mintest-get-id vec) (vector-ref vec 0))
(define (db:mintest-get-run_id vec) (vector-ref vec 1))
(define (db:mintest-get-testname vec) (vector-ref vec 2))
(define (db:mintest-get-state vec) (vector-ref vec 3))
(define (db:mintest-get-status vec) (vector-ref vec 4))
(define (db:mintest-get-event_time vec) (vector-ref vec 5))
(define (db:mintest-get-item_path vec) (vector-ref vec 6))
;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk
(define (make-db:testmeta)(make-vector 10 ""))
(define (db:testmeta-get-id vec) (vector-ref vec 0))
(define (db:testmeta-get-testname vec) (vector-ref vec 1))
(define (db:testmeta-get-author vec) (vector-ref vec 2))
(define (db:testmeta-get-owner vec) (vector-ref vec 3))
(define (db:testmeta-get-description vec) (vector-ref vec 4))
(define (db:testmeta-get-reviewed vec) (vector-ref vec 5))
(define (db:testmeta-get-iterated vec) (vector-ref vec 6))
(define (db:testmeta-get-avg_runtime vec) (vector-ref vec 7))
(define (db:testmeta-get-avg_disk vec) (vector-ref vec 8))
(define (db:testmeta-get-tags vec) (vector-ref vec 9))
(define (db:testmeta-set-id! vec val)(vector-set! vec 0 val))
(define (db:testmeta-set-testname! vec val)(vector-set! vec 1 val))
(define (db:testmeta-set-author! vec val)(vector-set! vec 2 val))
(define (db:testmeta-set-owner! vec val)(vector-set! vec 3 val))
(define (db:testmeta-set-description! vec val)(vector-set! vec 4 val))
(define (db:testmeta-set-reviewed! vec val)(vector-set! vec 5 val))
(define (db:testmeta-set-iterated! vec val)(vector-set! vec 6 val))
(define (db:testmeta-set-avg_runtime! vec val)(vector-set! vec 7 val))
(define (db:testmeta-set-avg_disk! vec val)(vector-set! vec 8 val))
;;======================================================================
;; S I M P L E R U N
;;======================================================================
;; (defstruct id "runname" "state" "status" "owner" "event_time"
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (make-db:test-data)(make-vector 10))
(define (db:test-data-get-id vec) (vector-ref vec 0))
(define (db:test-data-get-test_id vec) (vector-ref vec 1))
(define (db:test-data-get-category vec) (vector-ref vec 2))
(define (db:test-data-get-variable vec) (vector-ref vec 3))
(define (db:test-data-get-value vec) (vector-ref vec 4))
(define (db:test-data-get-expected vec) (vector-ref vec 5))
(define (db:test-data-get-tol vec) (vector-ref vec 6))
(define (db:test-data-get-units vec) (vector-ref vec 7))
(define (db:test-data-get-comment vec) (vector-ref vec 8))
(define (db:test-data-get-status vec) (vector-ref vec 9))
(define (db:test-data-get-type vec) (vector-ref vec 10))
(define (db:test-data-get-last_update vec) (vector-ref vec 11))
(define (db:test-data-set-id! vec val)(vector-set! vec 0 val))
(define (db:test-data-set-test_id! vec val)(vector-set! vec 1 val))
(define (db:test-data-set-category! vec val)(vector-set! vec 2 val))
(define (db:test-data-set-variable! vec val)(vector-set! vec 3 val))
(define (db:test-data-set-value! vec val)(vector-set! vec 4 val))
(define (db:test-data-set-expected! vec val)(vector-set! vec 5 val))
(define (db:test-data-set-tol! vec val)(vector-set! vec 6 val))
(define (db:test-data-set-units! vec val)(vector-set! vec 7 val))
(define (db:test-data-set-comment! vec val)(vector-set! vec 8 val))
(define (db:test-data-set-status! vec val)(vector-set! vec 9 val))
(define (db:test-data-set-type! vec val)(vector-set! vec 10 val))
;;======================================================================
;; S T E P S
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time
(define (make-db:step)(make-vector 9))
(define (tdb:step-get-id vec) (vector-ref vec 0))
(define (tdb:step-get-test_id vec) (vector-ref vec 1))
(define (tdb:step-get-stepname vec) (vector-ref vec 2))
(define (tdb:step-get-state vec) (vector-ref vec 3))
(define (tdb:step-get-status vec) (vector-ref vec 4))
(define (tdb:step-get-event_time vec) (vector-ref vec 5))
(define (tdb:step-get-logfile vec) (vector-ref vec 6))
(define (tdb:step-get-comment vec) (vector-ref vec 7))
(define (tdb:step-get-last_update vec) (vector-ref vec 8))
(define (tdb:step-set-id! vec val)(vector-set! vec 0 val))
(define (tdb:step-set-test_id! vec val)(vector-set! vec 1 val))
(define (tdb:step-set-stepname! vec val)(vector-set! vec 2 val))
(define (tdb:step-set-state! vec val)(vector-set! vec 3 val))
(define (tdb:step-set-status! vec val)(vector-set! vec 4 val))
(define (tdb:step-set-event_time! vec val)(vector-set! vec 5 val))
(define (tdb:step-set-logfile! vec val)(vector-set! vec 6 val))
(define (tdb:step-set-comment! vec val)(vector-set! vec 7 val))
;; The steps table
(define (make-db:steps-table)(make-vector 5))
(define (tdb:steps-table-get-stepname vec) (vector-ref vec 0))
(define (tdb:steps-table-get-start vec) (vector-ref vec 1))
(define (tdb:steps-table-get-end vec) (vector-ref vec 2))
(define (tdb:steps-table-get-status vec) (vector-ref vec 3))
(define (tdb:steps-table-get-runtime vec) (vector-ref vec 4))
(define (tdb:steps-table-get-log-file vec) (vector-ref vec 5))
(define (tdb:step-stable-set-stepname! vec val)(vector-set! vec 0 val))
(define (tdb:step-stable-set-start! vec val)(vector-set! vec 1 val))
(define (tdb:step-stable-set-end! vec val)(vector-set! vec 2 val))
(define (tdb:step-stable-set-status! vec val)(vector-set! vec 3 val))
(define (tdb:step-stable-set-runtime! vec val)(vector-set! vec 4 val))
;; ;; The data structure for handing off requests via wire
;; (define (make-cdb:packet)(make-vector 6))
;; (define (cdb:packet-get-client-sig vec) (vector-ref vec 0))
;; (define (cdb:packet-get-qtype vec) (vector-ref vec 1))
;; (define (cdb:packet-get-immediate vec) (vector-ref vec 2))
;; (define (cdb:packet-get-query-sig vec) (vector-ref vec 3))
;; (define (cdb:packet-get-params vec) (vector-ref vec 4))
;; (define (cdb:packet-get-qtime vec) (vector-ref vec 5))
;; (define (cdb:packet-set-client-sig! vec val)(vector-set! vec 0 val))
;; (define (cdb:packet-set-qtype! vec val)(vector-set! vec 1 val))
;; (define (cdb:packet-set-immediate! vec val)(vector-set! vec 2 val))
;; (define (cdb:packet-set-query-sig! vec val)(vector-set! vec 3 val))
;; (define (cdb:packet-set-params! vec val)(vector-set! vec 4 val))
;; (define (cdb:packet-set-qtime! vec val)(vector-set! vec 5 val))
|
Modified dbmod.scm
from [fbe6ad1d2c]
to [6473e71a88].
︙ | | |
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses mtmod))
(module dbmod
(
db:test-get-event_time
db:test-get-item-path
db:test-get-testname
db:get-value-by-header
()
db:get-subdb
db:multi-db-sync
dbmod:open-dbmoddb
dbmod:run-id->dbfname
db:roll-up-rules
db:get-all-state-status-counts-for-test
db:test-set-state-status-db
db:general-call
db:convert-test-itempath
db:test-data-rollup
db:keep-trying-until-true
db:get-test-info-by-id
db:with-db
db:get-test-id
db:get-test-info
dbmod:print-db-stats
db:get-keys
db:open-no-sync-db
db:add-stats
;; dbr:counts record accessors
dbr:counts->alist
db:add-var
db:archive-register-block-name
db:archive-register-disk
db:create-all-triggers
db:csv->test-data
db:dec-var
db:del-var
db:delete-old-deleted-test-records
db:delete-run
db:delete-steps-for-test!
db:delete-test-records
db:drop-all-triggers
db:get-all-run-ids
db:get-all-runids
db:get-changed-record-ids
db:get-changed-record-run-ids
db:get-changed-record-test-ids
db:get-count-tests-running
db:get-count-tests-running-for-run-id
db:get-count-tests-running-for-testname
db:get-count-tests-running-in-jobgroup
db:get-data-info-by-id
db:get-key-val-pairs
db:get-key-vals
db:get-latest-host-load
db:get-main-run-stats
db:get-matching-previous-test-run-records
db:get-not-completed-cnt
db:get-num-runs
db:get-prereqs-not-met
db:get-prev-run-ids
db:get-raw-run-stats
db:get-run-ids-matching-target
db:get-run-info
db:get-run-name-from-id
db:get-run-record-ids
db:get-run-state
db:get-run-state-status
db:get-run-stats
db:get-run-status
db:get-run-times
db:get-runs
db:get-runs-by-patt
db:get-runs-cnt-by-patt
db:get-steps-data
db:get-steps-for-test
db:get-steps-info-by-id
db:get-target
db:get-targets
db:get-test-state-status-by-id
db:get-test-times
db:get-testinfo-state-status
db:get-tests-for-run
db:get-tests-for-run-mindata
db:get-tests-for-run-state-status
db:get-tests-tags
db:get-toplevels-and-incompletes
db:get-var
db:have-incompletes?
db:inc-var
db:initialize-main-db
db:insert-run
db:insert-test
db:lock/unlock-run
db:login
db:read-test-data
db:read-test-data-varpatt
db:register-run
db:set-run-state-status
db:set-run-status
db:set-state-status-and-roll-up-run
db:set-var
db:simple-get-runs
db:test-get-archive-block-info
db:test-get-logfile-info
db:test-get-paths-matching-keynames-target-new
db:test-get-records-for-index-file
db:test-get-rundir-from-test-id
db:test-get-top-process-pid
db:test-set-archive-block-id
db:test-set-state-status
db:test-set-top-process-pid
db:test-toplevel-num-items
db:testmeta-add-record
db:testmeta-get-record
db:testmeta-update-field
db:teststep-set-status!
db:top-test-set-per-pf-counts
db:update-run-event_time
db:update-run-stats
db:update-tesdata-on-repilcate-db
tasks:add
tasks:find-task-queue-records
tasks:get-last
tasks:set-state-given-param-key
*db-stats*
dbmod:nfs-get-dbstruct
*db-stats-mutex*
db:get-header
db:get-rows
db:get-changed-run-ids
db:set-sync
db:setup
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
data-structures
|
︙ | | |
Modified fsmod.scm
from [4a6fab4260]
to [5fe1b052db].
︙ | | |
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
+
+
+
+
+
+
|
(declare (uses commonmod))
(declare (uses processmod))
(use srfi-69)
(module fsmod
(
get-df
get-uname
common:get-disk-with-most-free-space
common:get-disk-space-used
common:check-db-dir-and-exit-if-insufficient
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
|
︙ | | |
Modified key_records.scm
from [55f6701b87]
to [8cb99c889a].
︙ | | |
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
14
15
16
17
18
19
20
|
-
-
-
-
-
-
-
-
-
-
-
-
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(define (keys->valslots keys) ;; => ?,?,? ....
(string-intersperse (map (lambda (x) "?") keys) ","))
;; (define (keys->key/field keys . additional)
;; (string-join (map (lambda (k)(conc k " TEXT"))
;; (append keys additional)) ","))
(define (item-list->path itemdat)
(if (list? itemdat)
(string-intersperse (map cadr itemdat) "/")
""))
|
Modified launchmod.scm
from [8537366471]
to [85fd072687].
︙ | | |
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
+
-
+
|
(declare (uses runsmod))
(declare (uses fsmod))
(use srfi-69)
(module launchmod
(
rmt:find-and-mark-incomplete
)
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
ports
|
︙ | | |
Modified megatest.scm
from [ed279adec4]
to [72e4d22039].
︙ | | |
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
-
+
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;; (include "common.scm")
(include "megatest-version.scm")
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(declare (uses common))
;; (declare (uses megatest-version))
;; (declare (uses margs))
|
︙ | | |
Modified megatestmod.scm
from [6b2a3fefa4]
to [5c7bd63407].
︙ | | |
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
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
|
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(declare (uses servermod))
(declare (uses fsmod))
(use srfi-69)
(module megatestmod
(
db:set-tests-state-status
db:set-state-status-and-roll-up-items
common:get-install-area
tests:get-all
common:use-cache?
)
mt:lazy-read-test-config
common:get-full-test-name
tests:extend-test-patts
tests:get-itemmaps
tests:get-items
tests:get-global-waitons
tests:get-tests-search-path
tests:filter-test-names
common:args-get-testpatt
tests:filter-test-names-not-matched
common:args-get-runname
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
ports
|
︙ | | |
Modified mtexec.scm
from [8cf589213b]
to [e107d3437d].
︙ | | |
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
-
+
|
(declare (uses configfmod))
(import commonmod
configfmod
(prefix mtargs args:))
;; (use ducttape-lib)
(include "megatest-version.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
;; (require-library stml)
(define help (conc "
mtutil, part of the Megatest tool suite, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
|
︙ | | |
Modified mtmod.scm
from [6035871247]
to [4d23e65eeb].
︙ | | |
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
47
48
49
50
51
52
53
54
|
+
+
+
+
+
+
+
+
+
+
|
(declare (uses configfmod))
;; (declare (uses tcp-transportmod)) ;; we don't want mtmod depending on tcp
(use srfi-69)
(module mtmod
(
keys:make-key/field-string
common:get-testsuite-name
items:get-items-from-config
mt:run-trigger
common:get-linktree
common:get-area-name
items:check-valid-items
mt:discard-blocked-tests
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
|
︙ | | |
Modified processmod.scm
from [75e84b2970]
to [42996e8ab1].
︙ | | |
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
+
+
+
|
(declare (uses commonmod))
(use srfi-69)
(module processmod
(
process:cmd-run->list
process:alive?
run-n-wait
process:cmd-run-with-stderr-and-exitcode->list
)
(import scheme)
(cond-expand
(chicken-4
|
︙ | | |
Modified rmtmod.scm
from [3e961c57f1]
to [5bfa5082f0].
︙ | | |
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
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 tcp-transportmod))
(declare (uses apimod))
(declare (uses servermod))
(module rmtmod
(
rmtmod:send-receive
rmt:no-sync-get-lock
rmt:no-sync-del!
rmt:no-sync-set
rmt:no-sync-get/default
rmt:get-runs-by-patt
rmt:get-testinfo-state-status
rmt:get-test-id
rmt:set-state-status-and-roll-up-items
)
rmt:get-prereqs-not-met
rmt:get-tests-for-run
rmt:get-keys
rmt:test-get-records-for-index-file
tests:test-set-toplog!
rmt:test-get-logfile-info
rmt:general-call
rmt:test-get-paths-matching-keynames-target-new
rmt:get-test-info-by-id
rmt:get-steps-for-test
rmt:get-num-runs
rmt:get-runs-cnt-by-patt
rmt:get-runs
rmt:get-latest-host-load
rmt:get-changed-record-test-ids
rmt:get-all-runids
rmt:get-changed-record-run-ids
rmt:get-run-record-ids
rmt:get-data-info-by-id
rmt:get-steps-info-by-id
rmt:get-target
rmt:get-run-name-from-id
rmt:get-run-info
rmt:get-test-times
rmt:get-run-times
rmt:tasks-find-task-queue-records
common:api-changed?
rmt:on-homehost?
rmt:get-var
rmt:csv->test-data
rmt:get-previous-test-run-record
common:cleanup-db
common:get-last-run-version
rmt:get-key-val-pairs
rmt:create-all-triggers
rmt:update-tesdata-on-repilcate-db
rmt:drop-all-triggers
rmt:test-get-archive-block-info
rmt:test-toplevel-num-items
rmt:archive-get-allocations
rmt:archive-register-disk
rmt:archive-register-block-name
mt:get-runs-by-patt
rmt:simple-get-runs
rmt:get-tests-for-runs-mindata
rmt:test-get-top-process-pid
rmt:set-state-status-and-roll-up-run
rmt:get-run-state-status
rmt:get-not-completed-cnt
rmt:get-tests-tags
rmt:testmeta-update-field
rmt:testmeta-add-record
rmt:testmeta-get-record
rmt:lock/unlock-run
rmt:delete-old-deleted-test-records
rmt:delete-run
rmt:get-raw-run-stats
rmt:update-run-stats
rmt:delete-test-records
rmt:test-set-archive-block-id
mt:get-tests-for-run
mt:test-set-state-status-by-testname
mt:test-set-state-status-by-testname-unless-completed
rmt:register-test
mt:test-set-state-status-by-id-unless-completed
rmt:get-all-run-ids
rmt:set-run-state-status
rmt:set-var
rmt:set-tests-state-status
rmt:tasks-add
rmt:tasks-set-state-given-param-key
rmt:register-run
rmt:get-count-tests-running-in-jobgroup
rmt:get-count-tests-running-for-run-id
rmt:test-set-state-status-by-id
mt:test-set-state-status-by-id
)
(import scheme
chicken
data-structures
regex
extras
matchable
|
︙ | | |
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
|
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
|
-
-
-
-
+
+
+
+
|
(define (rmt:update-run-event_time run-id)
(assert (number? run-id) "FATAL: Run id required.")
(rmt:send-receive 'update-run-event_time #f (list run-id)))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-runs-update #!key (sort-order "asc")) ;; fields of #f uses default
(rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update sort-order)))
(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
(assert (number? run-id) "FATAL: Run id required.")
;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime))
(rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))) ;; )
;; (define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
;; (assert (number? run-id) "FATAL: Run id required.")
;; ;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime))
;; (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))) ;; )
(define (rmt:get-main-run-stats run-id)
(assert (number? run-id) "FATAL: Run id required.")
(rmt:send-receive 'get-main-run-stats #f (list run-id)))
(define (rmt:get-var varname)
(rmt:send-receive 'get-var #f (list varname)))
|
︙ | | |
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
|
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
|
-
-
-
-
-
+
+
+
+
+
|
(rmt:send-receive 'add-var #f (list varname value)))
;;======================================================================
;; M U L T I R U N Q U E R I E S
;;======================================================================
;; Need to move this to multi-run section and make associated changes
(define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
(let ((run-ids (rmt:get-all-run-ids)))
(for-each (lambda (run-id)
(rmt:find-and-mark-incomplete run-id ovr-deadtime))
run-ids)))
;; (define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
;; (let ((run-ids (rmt:get-all-run-ids)))
;; (for-each (lambda (run-id)
;; (rmt:find-and-mark-incomplete run-id ovr-deadtime))
;; run-ids)))
;; get the previous record for when this test was run where all keys match but runname
;; returns #f if no such test found, returns a single test record if found
;;
;; Run this at the client end since we have to connect to multiple run-id dbs
;;
(define (rmt:get-previous-test-run-record run-id test-name item-path)
|
︙ | | |
Modified servermod.scm
from [645e9767b0]
to [8f38f0674c].
︙ | | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
+
+
+
+
|
(declare (uses configfmod))
(declare (uses mtmod))
(declare (uses debugprint))
(declare (uses mtargs))
(module servermod
(
remote-hh-dat
server:mk-signature
common:wait-for-normalized-load
)
(import scheme
chicken)
(use (srfi 18) extras s11n)
(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
|
︙ | | |
Modified subrunmod.scm
from [f9fbf4371e]
to [0a6ed5a468].
︙ | | |
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
+
+
+
+
+
+
|
(declare (uses megatestmod))
(declare (uses tasksmod))
(use srfi-69)
(module subrunmod
(
subrun:set-state-status
subrun:kill-subrun
subrun:get-log-path
subrun:remove-subrun
subrun:subrun-removed?
subrun:subrun-test-initialized?
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
|
︙ | | |
Modified tasksmod.scm
from [434f7131ba]
to [4185a9e4a7].
︙ | | |
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
+
+
+
+
+
+
+
+
+
|
(declare (uses mtmod))
(declare (uses megatestmod))
(use srfi-69)
(module tasksmod
(
configf:write-alist
common:simple-unlock
common:simple-lock
tests:test-set-status!
common:get-launcher
tasks:kill-runner
tests:get-testconfig
tests:get-waitons
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
|
︙ | | |
Modified tcmt.scm
from [114f35b4de]
to [fd7d43aafe].
︙ | | |
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
-
+
|
(use trace)
;; (trace-call-sites #t)
(import commonmod
rmtmod
(prefix mtargs args:))
(include "megatest-version.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
;; (include "db_records.scm")
(define origargs (cdr (argv)))
(define remargs (args:get-args
(argv)
`( "-target"
|
︙ | | |
Modified tcp-transportmod.scm
from [d7197f9de1]
to [8cd3530dc9].
︙ | | |
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
+
+
+
+
+
+
+
+
+
+
|
(declare (uses portlogger))
(declare (uses mtmod))
(use address-info tcp)
(module tcp-transportmod
(
tt:mk-signature
tt-state
tt:server-process-run
tt:make-remote
tt-ro-mode-checked-set!
tt-ro-mode-set!
tt-ro-mode
tt-ro-mode-checked
tt:handler
tt:get-conn
)
(import scheme)
(cond-expand
(chicken-4
(import (prefix sqlite3 sqlite3:)
|
︙ | | |
Modified test_records.scm
from [d106f3911c]
to [1501321c72].
︙ | | |
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
|
11
12
13
14
15
16
17
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
(define (tests:testqueue-get-testname vec) (vector-ref vec 0))
(define (tests:testqueue-get-testconfig vec) (vector-ref vec 1))
(define (tests:testqueue-get-waitons vec) (vector-ref vec 2))
(define (tests:testqueue-get-priority vec) (vector-ref vec 3))
;; items: #f=no items, list=list of items remaining, proc=need to call to get items
(define (tests:testqueue-get-items vec) (vector-ref vec 4))
(define (tests:testqueue-get-itemdat vec) (vector-ref vec 5))
(define (tests:testqueue-get-item_path vec) (vector-ref vec 6))
(define (tests:testqueue-set-testname! vec val)(vector-set! vec 0 val))
(define (tests:testqueue-set-testconfig! vec val)(vector-set! vec 1 val))
(define (tests:testqueue-set-waitons! vec val)(vector-set! vec 2 val))
(define (tests:testqueue-set-priority! vec val)(vector-set! vec 3 val))
(define (tests:testqueue-set-items! vec val)(vector-set! vec 4 val))
(define (tests:testqueue-set-itemdat! vec val)(vector-set! vec 5 val))
(define (tests:testqueue-set-item_path! vec val)(vector-set! vec 6 val))
|
Modified testsmod.scm
from [15ae1fecd5]
to [9eb37a6a8e].
︙ | | |
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
+
+
+
|
(declare (uses fsmod))
(use srfi-69)
(module testsmod
(
tests:summarize-items
tests:filter-non-runnable
tests:sort-by-priority-and-waiton
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
|
︙ | | |
Modified tree.scm
from [c97437439f]
to [ee0f2b29cf].
︙ | | |
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
-
+
|
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(import (prefix mtargs args:)
debugprint)
(include "megatest-version.scm")
;; (include "megatest-version.scm")
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
;;======================================================================
;; T R E E S T U F F
;;======================================================================
|
︙ | | |