︙ | | |
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
|
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
|
-
-
+
+
-
-
-
+
-
-
+
+
+
+
+
-
-
+
-
-
|
fossil timeline -n 350 -t ci -F "%h,%a,%b,%t,\"%c\"" > recent-commits.csv
SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES = common.scm launch.scm runconfig.scm \
server.scm configf.scm keys.scm \
SRCFILES = runconfig.scm \
server.scm keys.scm \
process.scm runs.scm genexample.scm \
tdb.scm mt.scm \
ezsteps.scm api.scm \
subrun.scm archive.scm env.scm \
archive.scm env.scm
diff-report.scm
# cgisetup/models/pgdb.scm
# module source files
MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \
tcp-transportmod.scm rmtmod.scm portlogger.scm apimod.scm \
configfmod.scm processmod.scm servermod.scm megatestmod.scm \
stml2.scm fsmod.scm cpumod.scm mtmod.scm odsmod.scm \
pkts.scm testsmod.scm pgdb.scm cookie.scm launchmod.scm \
subrunmod.scm runsmod.scm tasksmod.scm archivemod.scm \
ezstepsmod.scm
ezstepsmod.scm mtbody.scm envmod.scm genexample.scm mutils.scm \
diff-report.scm tdb.scm vgmod.scm dcommon.scm
transport-mode.scm : transport-mode.scm.template
cp transport-mode.scm.template transport-mode.scm
dashboard-transport-mode.scm : dashboard-transport-mode.scm.template
cp dashboard-transport-mode.scm.template dashboard-transport-mode.scm
mtest : transport-mode.scm
dboard : dashboard-transport-mode.scm
# dbmod.import.o is just a hack here
mofiles/mtbody.o : mofiles/launchmod.o readline-fix.scm mofiles/envmod.o mofiles/genexample.o mofiles/mutils.o mofiles/diff-report.o mofiles/tdb.o
mofiles/dcommon.o : mofiles/vgmod.o
process.o : mofiles/processmod.o
mofiles/configfmod.o : mofiles/processmod.o
mofiles/processmod.o : mofiles/commonmod.o
mofiles/servermod.o : mofiles/commonmod.o
mofiles/rmtmod.o : mofiles/mtmod.o mofiles/apimod.o
mofiles/dbmod.o : mofiles/mtmod.o
# mofiles/mtmod.o : mofiles/tcp-transportmod.o
mofiles/megatestmod.o : mofiles/pkts.o mofiles/servermod.o mofiles/fsmod.o
# mofiles/mtmod.o : mofiles/testsmod.o
mofiles/subrunmod.o : mofiles/tasksmod.o
mofiles/dcommon.o : mofiles/tasksmod.o
mofiles/launchmod.o : mofiles/subrunmod.o mofiles/runsmod.o
mofiles/launchmod.o : mofiles/ezstepsmod.o
mofiles/runsmod.o : mofiles/archivemod.o
mofiles/testsmod.o : mofiles/dbmod.o
mofiles/dbfile.o : \
mofiles/debugprint.o mofiles/commonmod.o mofiles/configfmod.o
mofiles/apimod.o : mofiles/commonmod.o mofiles/tcp-transportmod.o mofiles/configfmod.o mofiles/megatestmod.o
mofiles/dbmod.o : mofiles/dbfile.o
mofiles/api.o : mofiles/apimod.o
mofiles/commonmod.o : mofiles/debugprint.o mofiles/stml2.o
configf.o : commonmod.import.o
mofiles/dbfile.o : mofiles/debugprint.o
mofiles/rmtmod.o mofiles/dbmod.o : mofiles/dbfile.o mofiles/commonmod.o mofiles/debugprint.o
db.o : mofiles/dbmod.o mofiles/dbfile.o
mofiles/debugprint.o : mofiles/mtargs.o
mofiles/tcp-transportmod.o : mofiles/portlogger.o
mofiles/tasksmod.o : mofiles/rmtmod.o mofiles/pgdb.o
mofiles/fsmod.o : mofiles/debugprint.o
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \
# mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm \
# rmtmod.scm apimod.scm
GUISRCF = dashboard-context-menu.scm dashboard-tests.scm \
GUISRCF = dashboard-guimonitor.scm
dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm \
vg.scm
OFILES = $(SRCFILES:%.scm=%.o)
GOFILES = $(GUISRCF:%.scm=%.o)
MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
# compiled import files
MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
|
︙ | | |
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
-
|
# rmt.o \
# runconfig.o \
# runs.o \
# server.o \
# tasks.o \
# tdb.o \
# tests.o \
# subrun.o \
# ezsteps.o
#
# # mofiles/rmtmod.o \
# # mofiles/commonmod.o \
#
# tcmt : $(TCMTOBJS) tcmt.scm megatest-version.scm $(MOFILES) $(MOIMPFILES)
# csc $(CSCOPTS) $(TCMTOBJS) $(MOFILES) $(MOIMPFILES) tcmt.scm -o tcmt
|
︙ | | |
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
|
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
|
-
+
-
-
+
+
-
+
-
+
-
-
-
+
-
+
-
-
-
|
$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
# Special dependencies for the includes
$(MOFILE) $(MOIMPFILES) : megatest-fossil-hash.scm
mofiles/commonmod.o : mofiles/debugprint.o megatest-fossil-hash.scm
common.o : mofiles/commonmod.o
mofiles/configfmod.o : mofiles/commonmod.o
mofiles/configfmod.o : mofiles/commonmod.o configf-guts.scm
# mofiles/dbmod.o : mofiles/configfmod.o
# commonmod.o dashboard.o megatest.o tcmt.o apimod.o : megatest-fossil-hash.scm
tests.o db.o launch.o runs.o dashboard-tests.o \
dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o \
tests.o db.o launch.o \
dashboard-guimonitor.o dashboard-main.o \
monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm
tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o : run_records.scm
tests.o dashboard.o dashboard-main.o : run_records.scm
db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm
db.o ezsteps.o keys.o launch.o megatest.o monitor.o tests.o : key_records.scm
db.o api.o : mofiles/dbmod.o mofiles/dbfile.o mofiles/debugprint.o mofiles/commonmod.o dbmod.import.o
tests.o tasks.o dashboard-tasks.o : task_records.scm
runs.o : test_records.scm
# mofiles-made : $(MOFILES)
# make $(MOIMPFILES)
# touch mofiles-made
megatest.o : megatest-fossil-hash.scm megatest-version.scm $(MOFILES) $(MOIMPFILES)
common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm dcommon.scm ezsteps.scm index-tree.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tree.scm : common_records.scm megatest-version.scm
common.scm configf.scm dashboard-guimonitor.scm dashboard.scm dcommon.scm ezsteps.scm index-tree.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm server.scm tdb.scm : common_records.scm megatest-version.scm
common_records.scm : altdb.scm
mofiles/dbfile.o : mofiles/commonmod.o
# mofiles/stml2.o : mofiles/cookie.o
# configf.o : mofiles/commonmod.o
vg.o dashboard.o : vg_records.scm megatest-version.scm
dashboard.o : megatest-version.scm
dcommon.o : run_records.scm
mofiles/stml2.o : mofiles/cookie.o
# # special include based modules
# mofiles/pkts.o : pkts/pkts.scm
# mofiles/stml2.o : cookie.o
# # mofiles/mtargs.o : mtargs/mtargs.scm
# # mofiles/mtconfigf.o : mtconfigf/mtconfigf.scm
# mofiles/ulex.o : ulex/ulex.scm
# mofiles/mutils.o : mutils/mutils.scm
# mofiles/cookie.o : stml2/cookie.scm
# mofiles/stml2.o : stml2/stml2.scm
# Temporary while transitioning to new routine
# runs.o : run-tests-queue-classic.scm run-tests-queue-new.scm
# for the modularized stuff
mofiles/rmtmod.o : mofiles/commonmod.o
megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm
echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new
if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi
|
︙ | | |
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
|
438
439
440
441
442
443
444
445
446
447
448
449
450
451
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) \
$(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut \
tcmt ftail.import.scm readline-fix.scm serialize-env \
dboard dboard.o megatest.o dashboard.o \
megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
rm -rf share
#======================================================================
# Make the records files
#======================================================================
# vg_records.scm : records.sh
# ./records.sh
#======================================================================
# Deploy section (not complete yet)
#======================================================================
$(DEPLOYHELPERS) : utils/mt_*
$(INSTALL) $< $@
chmod a+X $@
deploytarg/apropos.so : Makefile
chicken-install -p deploytarg -deploy -keep-installed $(EGGS)
deploy : deploytarg/mtest deploytarg/dboard $(DEPLOYHELPERS) deploytarg/nbfake deploytarg/remrun deploytarg/viewsceen deploytarg/nbfind deploytarg/apropos.so
# puts deployed megatest in directory "megatest"
deploytarg/mtest : $(OFILES) megatest.o deploytarg/apropos.so
csc -deploy $(CSCOPTS) $(OFILES) megatest.scm -o deploytarg
mv deploytarg/deploytarg deploytarg/mtest
deploytarg/dboard : $(OFILES) $(GOFILES) dashboard.scm deploytarg/apropos.so
csc -deploy $(OFILES) $(GOFILES) dashboard.scm -o deploytarg
mv deploytarg/deploytarg deploytarg/dboard
datashare-testing/sd : datashare.scm $(OFILES)
csc $(CSCOPTS) datashare.scm $(OFILES) -o datashare-testing/sd
datashare-testing/sdat: sharedat.scm $(OFILES)
csc $(CSCOPTS) sharedat.scm $(OFILES) -o datashare-testing/sdat
sd : datashare-testing/sd
mkdir -p /tmp/$(USER)/datashare/disk1 /tmp/$(USER)/basepath
xterm : sd
(export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)
datashare-testing/spublish : spublish.scm $(OFILES) megatest-version.scm
csc $(CSCOPTS) spublish.scm margs.o process.o common.o -o datashare-testing/spublish
datashare-testing/sretrieve : sretrieve.scm $(OFILES) megatest-version.scm
csc $(CSCOPTS) sretrieve.scm margs.o process.o common.o -o datashare-testing/sretrieve
datashare-testing/sauthorize : sauthorize.scm $(OFILES) megatest-version.scm
csc $(CSCOPTS) sauthorize.scm margs.o process.o common.o -o datashare-testing/sauthorize
sauth-init:
mkdir -p datashare-testing
rm datashare-testing/sauthorize
rm datashare-testing/sretrieve
rm datashare-testing/spublish
sauth : sauth-init datashare-testing/sauthorize datashare-testing/sretrieve datashare-testing/spublish
readline-fix.scm :
if [[ $(shell chicken-status | grep readline | awk '{print $4}' | cut -d. -f1) -gt 3 ]];then \
echo "(define *use-new-readline* #f)" > readline-fix.scm; \
else \
echo "(define *use-new-readline* #t)" > readline-fix.scm;\
fi
|
︙ | | |
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
|
462
463
464
465
466
467
468
469
470
471
472
473
474
475
|
-
-
-
-
|
if csi -ne '(import mysql-client)'&> /dev/null;then \
echo "(import mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \
fi
if csi -ne '(import postgresql)'&> /dev/null;then \
echo "(import postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
fi
# portlogger-example : portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o
# csc $(CSCOPTS) portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o sync-hash.o tasks.o tdb.o tests.o tree.o
# IMPORTSTUBS = $(*import.scm:%.scm=%)
unitdeps.dot : *mod.scm ./utils/plot-uses Makefile
./utils/plot-uses todot processmod.import,dbfile.import,dbmod.import,configfmod.import,mtmod.import,procesmod.import,commonmod.import,mtargs.import,mtargs,debugprint $$(ls *.scm|grep -v import) > unitdeps.dot
# ./utils/plot-uses todot commonmod,portlogger,stml2,debugprint,mtargs apimod.scm commonmod.scm configfmod.scm dbmod.scm megatestmod.scm mtmod.scm processmod.scm rmtmod.scm servermod.scm tcp-transportmod.scm > uses.dot ; dot uses.dot -Tpdf -o uses.pdf
# apimod.scm commonmod.scm configfmod.scm dbmod.scm megatestmod.scm mtmod.scm processmod.scm rmtmod.scm servermod.scm tcp-transportmod.scm testsmod.scm
|
︙ | | |
︙ | | |
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
archive:restore-db
*
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
ports
|
︙ | | |
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
-
+
|
srfi-13
srfi-18
srfi-69
typed-records
z3
)
(include "common_records.scm")
;; (include "common_records.scm")
;; (include "db_records.scm")
;;======================================================================
;;
;;======================================================================
;; ;; NOT CURRENTLY USED
|
︙ | | |
︙ | | |
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
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
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
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
typed-records
z3)
(import stml2
)
(module commonmod
(
;; globals
*already-seen-runconfig-info*
*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*
*configstatus*
*db-access-allowed*
*db-api-call-time*
*db-cache-path*
*db-keys*
*default-area-tag*
*env-vars-by-run-id*
*globalexitstatus*
*host-loads*
*keyvals*
*last-launch*
*launch-setup-mutex*
*logged-in-clients*
*my-client-signature*
*on-exit-procs*
*passnum*
*pkts-info*
*pre-reqs-met-cache*
*runconfigdat*
*runremote*
*server-id*
*server-info*
*target*
*task-db*
*test-meta-updated*
*testconfigs*
*time-to-exit*
*toppath*
*toptest-paths*
*transport-type*
*
*common:this-exe-dir*
common:list-is-sublist
seconds->year-week/day-time
common:find-start-mark-and-mark-delta
common:with-orig-env
alist->env-vars
any->number
any->number-if-possible
assoc/default
client:get-signature
common:alist-ref/default
common:clear-caches
common:dir-clean-up
common:directory-exists?
common:directory-writable?
common:fail-safe
common:file-exists?
common:find-local-megatest
common:generic-ssh
common:get-area-path-signature
common:get-color-from-status
common:get-cpu-load
common:get-create-writeable-dir
common:get-fields
common:get-intercept
common:get-megatest-exe
common:get-megatest-exe-dir
common:get-megatest-exe-path
common:get-mtexe
common:get-normalized-cpu-load
common:get-normalized-cpu-load
common:get-num-cpus
common:get-param-mapping
common:get-signature
common:get-toppath
common:hms-string->seconds
common:htree->html
common:human-time
common:in-running-test?
common:join-backgrounded-threads
common:lazy-sqlite-db-modification-time
common:list->htree
common:list-or-null
common:logpro-exit-code->status-sym
common:low-noise-print
common:make-tmpdir-name
common:max
common:min-max
common:nice-path
common:pkts-spec
common:raw-get-remote-host-load
common:read-encoded-string
common:real-path
common:send-thunk-to-background-thread
common:simple-file-lock
common:simple-file-lock-and-wait
common:simple-file-release-lock
common:sparse-list-generate-index
common:special-sort
common:steps-can-proceed-given-status-sym
common:sum
common:to-alist
common:unix-ping
common:val->alist
common:version-signature
common:which
common:with-env-vars
common:without-vars
common:worse-status-sym
commonmod:get-cpu-load
commonmod:is-test-alive
db:mintest-get-event_time
db:patt->like
db:test-data-get-category
db:test-data-get-comment
db:test-data-get-expected
db:test-data-get-id
db:test-data-get-last_update
db:test-data-get-status
db:test-data-get-test_id
db:test-data-get-tol
db:test-data-get-type
db:test-data-get-units
db:test-data-get-value
db:test-data-get-variable
db:test-get-archived
db:test-get-comment
db:test-get-cpuload
db:test-get-diskfree
db:test-get-event_time
db:test-get-final_logf
db:test-get-fullname
db:test-get-host
db:test-get-id
db:test-get-is-toplevel
db:test-get-item-path
db:test-get-last_update
db:test-get-process_id
db:test-get-run_duration
db:test-get-run_id
db:test-get-rundir
db:test-get-state
db:test-get-status
db:test-get-testname
db:test-get-uname
db:test-make-full-name
db:test-set-state!
db:test-set-status!
db:test-set-testname!
db:testmeta-get-author
db:testmeta-get-description
db:testmeta-get-owner
db:testmeta-get-reviewed
db:testmeta-get-tags
get-area-path-signature
get-normalized-cpu-load
getenv
host-last-cpuload
host-last-cpuload-set!
host-last-update
host-last-update-set!
host-last-used
host-last-used-set!
host-reachable
host-reachable-set!
item-list->path
keys->keystr
keys->valslots
keys:config-get-fields
keys:target->keyval
keys:target-set-args
make-db:testmeta
make-host
make-sparse-array
make-tests:testqueue
megatest-fossil-hash
megatest-version
number-of-processes-running
patt-list-match
rmt:transport-mode
runs:get-std-run-fields
safe-setenv
save-environment-as-files
sdb:qry
seconds->hr-min-sec
seconds->quarter
seconds->time-string
seconds->work-week/day
seconds->work-week/day-time
seconds->year-work-week/day-time
setenv
sparse-array-ref
sparse-array-set!
status-sym->string
stop-the-train
tasks:wait-on-journal
tdb:step-get-comment
tdb:step-get-event_time
tdb:step-get-id
tdb:step-get-last_update
tdb:step-get-logfile
tdb:step-get-state
tdb:step-get-status
tdb:step-get-stepname
tdb:step-get-test_id
tdb:steps-table-get-end
tdb:steps-table-get-log-file
tdb:steps-table-get-runtime
tdb:steps-table-get-start
tdb:steps-table-get-status
tdb:steps-table-get-stepname
tests:glob-like-match
tests:lookup-itemmap
tests:match
tests:match->sqlqry
tests:testqueue-get-item_path
tests:testqueue-get-itemdat
tests:testqueue-get-items
tests:testqueue-get-priority
tests:testqueue-get-testconfig
tests:testqueue-get-testname
tests:testqueue-get-waitons
tests:testqueue-set-item_path!
tests:testqueue-set-itemdat!
tests:testqueue-set-items!
tests:testqueue-set-priority!
val->alist
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
ports
(prefix base64 base64:)
|
︙ | | |
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
|
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
|
+
+
-
|
srfi-1
srfi-18
srfi-69
typed-records
system-information
debugprint
megatest-fossil-hash
)))
;;======================================================================
;; CONTENTS
;;
;; config file utils
;; misc conversion, data manipulation functions
;; testsuite and area utilites
;;
;;======================================================================
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "common_records.scm")
(include "test_records.scm")
;; http - use the old http + in /tmp db
;; tcp - use tcp transport with cachedb db
;; nfs - use direct to disk access (read-only)
;;
(define rmt:transport-mode (make-parameter 'tcp))
|
︙ | | |
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
|
+
|
(string-match "^(.*/csi|csi)$" (car argv))
(string-match "^-(s|ss|sx|script)$" (cadr argv)))
(caddr argv))
(else (car argv))))
(fullpath (realpath this-script)))
fullpath))
;; get rid of these, no need to slow down start up
;;======================================================================
(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
(define *common:this-exe-dir* (pathname-directory *common:this-exe-fullpath*))
(define *common:this-exe-name* (pathname-strip-directory *common:this-exe-fullpath*))
(define (common:get-sync-lock-filepath)
|
︙ | | |
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
|
+
|
(define *fdb* #f)
(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.
;; environment vars handy stuff from common.scm
;;
(define getenv get-environment-variable)
(define (safe-setenv key val)
(if (or (substring-index "!" key)
(substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
(substring-index "." key)) ;; periods are not allowed in environment variables
(debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
(if (and (string? val)
(string? key))
|
︙ | | |
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
|
805
806
807
808
809
810
811
812
813
814
815
816
817
818
|
-
-
-
|
;; convert string a=1; b=2; c=a silly thing; d=
(let ((valstr (lookup cfgdat section var)))
(if valstr
(val->alist valstr)
'()))) ;; should it return empty list or #f to indicate not set?
(define (get-section cfgdat section)
(hash-table-ref/default cfgdat section '()))
(define (common:make-tmpdir-name areapath tmpadj)
(let* ((area (pathname-file areapath))
(dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
(unless (directory-exists? dname)
(create-directory dname #t))
dname))
|
︙ | | |
2733
2734
2735
2736
2737
2738
2739
2740
2741
|
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
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
|
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
(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))
)
|