This is equivalent to a diff from
d69b03fe95
to f7bd519f51
Modified Makefile
from [0dc94ad098]
to [2907e793bf].
︙ | | |
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
|
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
|
-
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
+
+
+
-
+
|
process.scm runs.scm tasks.scm tests.scm genexample.scm \
http-transport.scm filedb.scm tdb.scm client.scm mt.scm \
ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm \
subrun.scm portlogger.scm archive.scm env.scm \
diff-report.scm cgisetup/models/pgdb.scm
# module source files
MSRCFILES =
MSRCFILES = dbmod.scm servermod.scm apimod.scm commonmod.scm rmtmod.scm
MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
MOIMPFILES = $(MSRCFILES:%.scm=%.import.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
DMSRCFILES = dcommonmod.scm
DMOFILES = $(addprefix mofiles/,$(DMSRCFILES:%.scm=%.o))
DMOIMPFILES = $(DMSRCFILES:%.scm=%.import.o)
GUISRCF = dashboard-context-menu.scm dashboard-tests.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)
%.import.o : %.import.scm
%.import.o : %.import.scm mofiles/%.o
csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o
# I'm not sure the cp is a good idea, changed a lot of things and it may not have been necessary...
# mofiles/%.o %.import.scm : %.scm megatest-fossil-hash.scm
# @[ -e mofiles ] || mkdir -p mofiles
# csc $(CSCOPTS) -I mofiles -I $* -J -c $< -o $*.o
# cp $*.o mofiles/$*.o
# @touch $*.import.scm # ensure it is touched after the .o is made
mofiles/%.o : %.scm
# ensure import.scm is touched after the .o is made
#
mofiles/%.o %.import.scm : %.scm
mkdir -p mofiles
csc $(CSCOPTS) -J -c $< -o mofiles/$*.o
@touch $*.import.scm
ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')
ifeq ($(MTESTHASH),)
|
︙ | | |
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
-
-
+
+
|
mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) $(MOIMPFILES) megatest-version.scm
csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest
showmtesthash:
@echo $(MTESTHASH)
dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard
dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) $(DMOFILES) $(DMOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) $(DMOFILES) $(DMOIMPFILES) -o dboard
mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm megatest-version.scm
csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut
# include makefile.inc
TCMTOBJS = \
|
︙ | | |
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
|
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
|
-
+
-
+
-
-
-
+
+
+
+
+
|
tests.o \
subrun.o \
ezsteps.o
# mofiles/rmtmod.o \
# mofiles/commonmod.o \
tcmt : $(TCMTOBJS) tcmt.scm megatest-version.scm
tcmt : $(TCMTOBJS) tcmt.scm megatest-version.scm $(MOIMPFILES) $(MOFILES)
csc $(CSCOPTS) $(TCMTOBJS) $(MOFILES) $(MOIMPFILES) tcmt.scm -o tcmt
# install documentation to $(PREFIX)/docs
# DOES NOT REBUILD DOCS
#
$(PREFIX)/share/docs/megatest_manual.html : docs/manual/megatest_manual.html
mkdir -p $(PREFIX)/share/docs
$(INSTALL) docs/manual/megatest_manual.html $(PREFIX)/share/docs/megatest_manual.html
for png in $(PNGFILES);do $(INSTALL) docs/manual/$$png $(PREFIX)/share/docs/$$png;done
# add a fake dependency so this doens't copy everytime
$(PREFIX)/share/js/jquery-3.1.0.slim.min.js : # .fslckout
mkdir -p $(PREFIX)/share/js
fossil wiki export java-script-lib > $(PREFIX)/share/js/jquery-3.1.0.slim.min.js
$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
mkdir -p $(PREFIX)/share/db
$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
# Special dependencies for the includes
# Special dependencies for the module includes
$(MOFILE) $(MOIMPFILES) : megatest-fossil-hash.scm
# common.o : mofiles/commonmod.o megatest-fossil-hash.scm
megatest.o : $(MOIMPFILES)
mofiles/commonmod.o : megatest-fossil-hash.scm
mofiles/dbmod.o mofiles/servermod.o mofiles/apimod.o mofiles/dcommonmod.o : mofiles/commonmod.o
mofiles/rmtmod.o : mofiles/apimod.o
common.o : mofiles/commonmod.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 \
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
|
︙ | | |
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
-
+
|
common_records.scm : altdb.scm
# mofiles/stml2.o : mofiles/cookie.o
# configf.o : mofiles/commonmod.o
vg.o dashboard.o : vg_records.scm megatest-version.scm
dcommon.o : run_records.scm
dcommon.o : mofiles/dcommonmod.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
|
︙ | | |
Modified api.scm
from [68ac71805c]
to [ee434c180b].
︙ | | |
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
|
+
+
+
|
(use srfi-69 posix)
(declare (unit api))
(declare (uses rmt))
(declare (uses db))
(declare (uses tasks))
(declare (uses commonmod))
(import commonmod)
;; allow these queries through without starting a server
;;
(define api:read-only-queries
'(get-key-val-pairs
get-var
get-keys
|
︙ | | |
Modified apimod.scm
from [0c866deee4]
to [91669f1e5a].
︙ | | |
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
-
+
-
+
|
;; 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 apimod))
(declare (uses commonmod))
(declare (uses ulex))
;; (declare (uses ulex))
(module apimod
*
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(import commonmod)
(import (prefix ulex ulex:))
;; (import (prefix ulex ulex:))
(define (api:execute-requests params)
#f)
)
|
Modified archive.scm
from [a5f3e3b4ad]
to [0a572a4ddb].
︙ | | |
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
+
+
+
|
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 format md5 message-digest srfi-18)
(declare (unit archive))
(declare (uses db))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
(include "db_records.scm")
;;======================================================================
;;
;;======================================================================
|
︙ | | |
Modified client.scm
from [dc4c7b41e8]
to [cecbbc9d00].
︙ | | |
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
+
+
+
|
spiffy-request-vars uri-common intarweb directory-utils)
(declare (unit client))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
(include "db_records.scm")
;; client:get-signature
(define (client:get-signature)
(if *my-client-signature* *my-client-signature*
|
︙ | | |
Modified common.scm
from [bf0a0a25ad]
to [f8fa1c917f].
︙ | | |
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
|
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
|
-
-
+
+
+
+
+
+
+
+
+
+
+
|
matchable regex posix (srfi 18) extras ;; tcp
(prefix nanomsg nmsg:)
(prefix sqlite3 sqlite3:)
pkts (prefix dbi dbi:)
)
(declare (unit common))
;; (declare (uses commonmod))
;; (import commonmod)
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
;; (require-library margs)
;; (include "margs.scm")
;; (define old-exit exit)
;;
;; (define (exit . code)
;; (if (null? code)
;; (old-exit)
;; (old-exit code)))
(define (common:debug-setup)
(debug:setup (cond ;; debug arg
((args:get-arg "-debug-noprop") 'noprop)
((args:get-arg "-debug") #t)
(else #f))
(cond ;; verbosity arg
((args:get-arg "-q") 'v)
((args:get-arg "-q") 'q)
(else #f))))
;; execute thunk, return value. If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* .
;; arguments - thunk, message
(define (common:fail-safe thunk warning-message-on-exception)
(handle-exceptions
exn
(begin
|
︙ | | |
801
802
803
804
805
806
807
808
809
810
811
812
813
814
|
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
|
+
+
+
+
+
+
|
(6 "CHECK")
(7 "STUCK/DEAD")
(8 "DEAD")
(9 "FAIL")
(10 "PREQ_FAIL")
(11 "PREQ_DISCARDED")
(12 "ABORT")))
(define (common:status>? s1 s2)
(let* ((munged (map (lambda (x) `(,(cadr x) . ,(car x))) *common:std-statuses*))
(v1 (alist-ref s1 munged equal?))
(v2 (alist-ref s2 munged equal?)))
(> v1 v2)))
(define *common:ended-states* ;; states which indicate the test is stopped and will not proceed
'("COMPLETED" "ARCHIVED" "KILLED" "KILLREQ" "STUCK" "INCOMPLETE" ))
(define *common:badly-ended-states* ;; these roll up as CHECK, i.e. results need to be checked
'("KILLED" "KILLREQ" "STUCK" "INCOMPLETE" "DEAD"))
|
︙ | | |
Modified common_records.scm
from [80f9e14f2d]
to [e4251bc312].
︙ | | |
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
|
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
|
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
|
;;
(define-inline (with-mutex mtx accessor record . val)
(mutex-lock! mtx)
(let ((res (apply accessor record val)))
(mutex-unlock! mtx)
res))
;; this was cached based on results from profiling but it turned out the profiling
;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
;; in for now but can probably take it out later.
;;
;; ;; this was cached based on results from profiling but it turned out the profiling
;; ;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
;; ;; in for now but can probably take it out later.
;; ;;
;; (define (debug:calc-verbosity vstr)
;; (or (hash-table-ref/default *verbosity-cache* vstr #f)
;; (let ((res (cond
;; ((number? vstr) vstr)
;; ((not (string? vstr)) 1)
;; ;; ((string-match "^\\s*$" vstr) 1)
;; (vstr (let ((debugvals (filter number? (map string->number (string-split vstr ",")))))
;; (cond
;; ((> (length debugvals) 1) debugvals)
;; ((> (length debugvals) 0)(car debugvals))
;; (else 1))))
;; ((args:get-arg "-v") 2)
;; ((args:get-arg "-q") 0)
;; (else 1))))
;; (hash-table-set! *verbosity-cache* vstr res)
;; res)))
;;
(define (debug:calc-verbosity vstr)
(or (hash-table-ref/default *verbosity-cache* vstr #f)
(let ((res (cond
((number? vstr) vstr)
((not (string? vstr)) 1)
;; ((string-match "^\\s*$" vstr) 1)
(vstr (let ((debugvals (filter number? (map string->number (string-split vstr ",")))))
(cond
((> (length debugvals) 1) debugvals)
((> (length debugvals) 0)(car debugvals))
(else 1))))
((args:get-arg "-v") 2)
((args:get-arg "-q") 0)
(else 1))))
(hash-table-set! *verbosity-cache* vstr res)
res)))
;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
(if (not (or (number? verbosity)
(list? verbosity)))
(begin
(print "ERROR: Invalid debug value \"" vstr "\"")
#f)
#t))
(define (debug:debug-mode n)
(cond
((and (number? *verbosity*) ;; number number
(number? n))
(<= n *verbosity*))
((and (list? *verbosity*) ;; list number
(number? n))
(member n *verbosity*))
((and (list? *verbosity*) ;; list list
(list? n))
(not (null? (lset-intersection! eq? *verbosity* n))))
((and (number? *verbosity*)
(list? n))
(member *verbosity* n))))
(define (debug:setup)
(let ((debugstr (or (args:get-arg "-debug")
(args:get-arg "-debug-noprop")
(getenv "MT_DEBUG_MODE"))))
(set! *verbosity* (debug:calc-verbosity debugstr))
(debug:check-verbosity *verbosity* debugstr)
;; if we were handed a bad verbosity rule then we will override it with 1 and continue
(if (not *verbosity*)(set! *verbosity* 1))
(if (and (not (args:get-arg "-debug-noprop"))
(or (args:get-arg "-debug")
(not (getenv "MT_DEBUG_MODE"))))
(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
(string-intersperse (map conc *verbosity*) ",")
(conc *verbosity*))))))
(define (debug:print n e . params)
(if (debug:debug-mode n)
(with-output-to-port (or e (current-error-port))
(lambda ()
(if *logging*
(db:log-event (apply conc params))
(apply print params)
)))))
;; Brandon's debug printer shortcut (indulge me :)
(define *BB-process-starttime* (current-milliseconds))
(define (BB> . in-args)
(let* ((stack (get-call-chain))
(location "??"))
(for-each
(lambda (frame)
(let* ((this-loc (vector-ref frame 0))
(temp (string-split (->string this-loc) " "))
(this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
(if (equal? this-func "BB>")
(set! location this-loc))))
stack)
(let* ((color-on "\x1b[1m")
(color-off "\x1b[0m")
(dp-args
(append
(list 0 *default-log-port*
(conc color-on location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000) color-off " ") )
in-args)))
(apply debug:print dp-args))))
(define *BBpp_custom_expanders_list* (make-hash-table))
;; register hash tables with BBpp.
(hash-table-set! *BBpp_custom_expanders_list* HASH_TABLE:
(cons hash-table? hash-table->alist))
;; test name converter
(define (BBpp_custom_converter arg)
(let ((res #f))
(for-each
(lambda (custom-type-name)
(let* ((custom-type-info (hash-table-ref *BBpp_custom_expanders_list* custom-type-name))
(custom-type-test (car custom-type-info))
(custom-type-converter (cdr custom-type-info)))
(when (and (not res) (custom-type-test arg))
(set! res (custom-type-converter arg)))))
(hash-table-keys *BBpp_custom_expanders_list*))
(if res (BBpp_ res) arg)))
(define (BBpp_ arg)
(cond
;;((SOMESTRUCT? arg) (cons SOMESTRUCT: (SOMESTRUCT->alist arg)))
;;((dboard:tabdat? arg) (cons dboard:tabdat: (dboard:tabdat->alist arg)))
((hash-table? arg)
(let ((al (hash-table->alist arg)))
(BBpp_ (cons HASH_TABLE: al))))
((null? arg) '())
;;((list? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
((pair? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
(else (BBpp_custom_converter arg))))
;; Brandon's pretty printer. It expands hashes and custom types in addition to regular pp
(define (BBpp arg)
(pp (BBpp_ arg)))
;(use define-macro)
(define-syntax inspect
(syntax-rules ()
[(_ x)
;; (with-output-to-port (current-error-port)
(printf "~a is: ~a\n" 'x (with-output-to-string (lambda () (BBpp x))))
;; )
;; ;; check verbosity, #t is ok
;; (define (debug:check-verbosity verbosity vstr)
;; (if (not (or (number? verbosity)
;; (list? verbosity)))
;; (begin
;; (print "ERROR: Invalid debug value \"" vstr "\"")
;; #f)
;; #t))
;;
;; (define (debug:debug-mode n)
;; (cond
;; ((and (number? *verbosity*) ;; number number
;; (number? n))
;; (<= n *verbosity*))
;; ((and (list? *verbosity*) ;; list number
;; (number? n))
;; (member n *verbosity*))
;; ((and (list? *verbosity*) ;; list list
;; (list? n))
;; (not (null? (lset-intersection! eq? *verbosity* n))))
;; ((and (number? *verbosity*)
;; (list? n))
;; (member *verbosity* n))))
;;
;; (define (debug:setup)
;; (let ((debugstr (or (args:get-arg "-debug")
;; (args:get-arg "-debug-noprop")
;; (getenv "MT_DEBUG_MODE"))))
;; (set! *verbosity* (debug:calc-verbosity debugstr))
;; (debug:check-verbosity *verbosity* debugstr)
;; ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
;; (if (not *verbosity*)(set! *verbosity* 1))
;; (if (and (not (args:get-arg "-debug-noprop"))
;; (or (args:get-arg "-debug")
;; (not (getenv "MT_DEBUG_MODE"))))
;; (setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
;; (string-intersperse (map conc *verbosity*) ",")
;; (conc *verbosity*))))))
;;
;; (define (debug:print n e . params)
;; (if (debug:debug-mode n)
;; (with-output-to-port (or e (current-error-port))
;; (lambda ()
;; (if *logging*
;; (db:log-event (apply conc params))
;; (apply print params)
;; )))))
;;
;; ;; Brandon's debug printer shortcut (indulge me :)
;; (define *BB-process-starttime* (current-milliseconds))
;; (define (BB> . in-args)
;; (let* ((stack (get-call-chain))
;; (location "??"))
;; (for-each
;; (lambda (frame)
;; (let* ((this-loc (vector-ref frame 0))
;; (temp (string-split (->string this-loc) " "))
;; (this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
;; (if (equal? this-func "BB>")
;; (set! location this-loc))))
;; stack)
;; (let* ((color-on "\x1b[1m")
;; (color-off "\x1b[0m")
;; (dp-args
;; (append
;; (list 0 *default-log-port*
;; (conc color-on location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000) color-off " ") )
;; in-args)))
;; (apply debug:print dp-args))))
;;
;; (define *BBpp_custom_expanders_list* (make-hash-table))
;;
;;
;;
;; ;; register hash tables with BBpp.
;; (hash-table-set! *BBpp_custom_expanders_list* HASH_TABLE:
;; (cons hash-table? hash-table->alist))
;;
;; ;; test name converter
;; (define (BBpp_custom_converter arg)
;; (let ((res #f))
;; (for-each
;; (lambda (custom-type-name)
;; (let* ((custom-type-info (hash-table-ref *BBpp_custom_expanders_list* custom-type-name))
;; (custom-type-test (car custom-type-info))
;; (custom-type-converter (cdr custom-type-info)))
;; (when (and (not res) (custom-type-test arg))
;; (set! res (custom-type-converter arg)))))
;; (hash-table-keys *BBpp_custom_expanders_list*))
;; (if res (BBpp_ res) arg)))
;;
;; (define (BBpp_ arg)
;; (cond
;; ;;((SOMESTRUCT? arg) (cons SOMESTRUCT: (SOMESTRUCT->alist arg)))
;; ;;((dboard:tabdat? arg) (cons dboard:tabdat: (dboard:tabdat->alist arg)))
;; ((hash-table? arg)
;; (let ((al (hash-table->alist arg)))
;; (BBpp_ (cons HASH_TABLE: al))))
;; ((null? arg) '())
;; ;;((list? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
;; ((pair? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
;; (else (BBpp_custom_converter arg))))
;;
;; ;; Brandon's pretty printer. It expands hashes and custom types in addition to regular pp
;; (define (BBpp arg)
;; (pp (BBpp_ arg)))
;;
;; ;(use define-macro)
;; (define-syntax inspect
;; (syntax-rules ()
;; [(_ x)
;; ;; (with-output-to-port (current-error-port)
;; (printf "~a is: ~a\n" 'x (with-output-to-string (lambda () (BBpp x))))
;; ;; )
;; ]
]
[(_ x y ...) (begin (inspect x) (inspect y ...))]))
(define (debug:print-error n e . params)
;; normal print
(if (debug:debug-mode n)
(with-output-to-port (if (port? e) e (current-error-port))
(lambda ()
(if *logging*
(db:log-event (apply conc params))
;; (apply print "pid:" (current-process-id) " " params)
(apply print "ERROR: " params)
))))
;; pass important messages to stderr
(if (and (eq? n 0)(not (eq? e (current-error-port))))
(with-output-to-port (current-error-port)
(lambda ()
(apply print "ERROR: " params)
))))
(define (debug:print-info n e . params)
(if (debug:debug-mode n)
(with-output-to-port (if (port? e) e (current-error-port))
(lambda ()
(if *logging*
(let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
(db:log-event res))
;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
(apply print "INFO: (" n ") " params) ;; res)
)))))
;; [(_ x y ...) (begin (inspect x) (inspect y ...))]))
;;
;; (define (debug:print-error n e . params)
;; ;; normal print
;; (if (debug:debug-mode n)
;; (with-output-to-port (if (port? e) e (current-error-port))
;; (lambda ()
;; (if *logging*
;; (db:log-event (apply conc params))
;; ;; (apply print "pid:" (current-process-id) " " params)
;; (apply print "ERROR: " params)
;; ))))
;; ;; pass important messages to stderr
;; (if (and (eq? n 0)(not (eq? e (current-error-port))))
;; (with-output-to-port (current-error-port)
;; (lambda ()
;; (apply print "ERROR: " params)
;; ))))
;;
;; (define (debug:print-info n e . params)
;; (if (debug:debug-mode n)
;; (with-output-to-port (if (port? e) e (current-error-port))
;; (lambda ()
;; (if *logging*
;; (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
;; (db:log-event res))
;; ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
;; (apply print "INFO: (" n ") " params) ;; res)
;; )))))
;;
;; if a value is printable (i.e. string or number) return the value
;; else return an empty string
(define-inline (printable val)
(if (or (number? val)(string? val)) val ""))
|
Modified commonmod.scm
from [9423abd515]
to [7ea60c4771].
︙ | | |
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
-
+
-
+
+
|
;;======================================================================
(declare (unit commonmod))
(module commonmod
*
(import scheme chicken data-structures extras files)
(import scheme chicken data-structures extras files ports)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
md5 message-digest
regex srfi-1)
regex srfi-1
format)
;;======================================================================
;; CONTENTS
;;
;; config file utils
;; misc conversion, data manipulation functions
;; testsuite and area utilites
|
︙ | | |
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;;
(define (get-cfg-areas cfgdat)
(let ((adat (get-section cfgdat "areas")))
(map (lambda (entry)
`(,(car entry) .
,(val->alist (cadr entry))))
adat)))
;;======================================================================
;; debug stuff
;;======================================================================
(define verbosity (make-parameter '()))
;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;;
;; (define (set-functions dbgp dbgpinfo)
;; (set! debug:print dbgp)
;; (set! debug:print-info dbgpinfo))
;; this was cached based on results from profiling but it turned out the profiling
;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
;; in for now but can probably take it out later.
;;
(define (debug:calc-verbosity vstr arg) ;; arg is 'v (verbose) or 'q (quiet)
(let* ((res (cond
((number? vstr) vstr)
((not (string? vstr)) 1)
;; ((string-match "^\\s*$" vstr) 1)
(vstr (let ((debugvals (filter number? (map string->number (string-split vstr ",")))))
(cond
((> (length debugvals) 1) debugvals)
((> (length debugvals) 0)(car debugvals))
(else 1))))
((eq? arg 'v) 2) ;; verbose
((eq? arg 'q) 0) ;; quiet
(else 1))))
(verbosity res)
res))
)
;; check verbosity, #t is ok
#;(define (debug-check-verbosity verbosity vstr)
(if (not (or (number? verbosity)
(list? verbosity)))
(begin
(print "ERROR: Invalid debug value \"" vstr "\"")
#f)
#t))
(define (debug:debug-mode n)
(let* ((vb (verbosity)))
(cond
((and (number? vb) ;; number number
(number? n))
(<= n vb))
((and (list? vb) ;; list number
(number? n))
(member n vb))
((and (list? vb) ;; list list
(list? n))
(not (null? (lset-intersection! eq? vb n))))
((and (number? vb)
(list? n))
(member vb n)))))
(define (debug:setup debug-arg verbose-arg) ;; debug-arg= #f, #t or 'noprop
(let ((debugstr (or debug-arg ;; (args:get-arg "-debug")
;; (args:get-arg "-debug-noprop")
(get-environment-variable "MT_DEBUG_MODE"))))
(debug:calc-verbosity debugstr verbose-arg)
;; (debug:check-verbosity *verbosity* debugstr)
;; if we were handed a bad verbosity rule then we will override it with 1 and continue
(if (not (verbosity))(set! (verbosity) 1))
(if (and (not (eq? debug-arg 'noprop))
(or debug-arg
(not (get-environment-variable "MT_DEBUG_MODE"))))
(setenv "MT_DEBUG_MODE" (if (list? (verbosity))
(string-intersperse (map conc (verbosity)) ",")
(conc (verbosity)))))))
(define (debug:print n e . params)
(if (debug:debug-mode n)
(with-output-to-port (or e (current-error-port))
(lambda ()
;; (if *logging*
;; (db:log-event (apply conc params))
(apply print params)
)))) ;; )
(define (debug:print-error n e . params)
;; normal print
(if (debug:debug-mode n)
(with-output-to-port (if (port? e) e (current-error-port))
(lambda ()
(apply print "ERROR: " params)
)))
;; pass important messages to stderr
(if (and (eq? n 0)(not (eq? e (current-error-port))))
(with-output-to-port (current-error-port)
(lambda ()
(apply print "ERROR: " params)
))))
(define (debug:print-info n e . params)
(if (debug:debug-mode n)
(with-output-to-port (if (port? e) e (current-error-port))
(lambda ()
(apply print "INFO: (" n ") " params) ;; res)
))))
)
|
Modified configf.scm
from [b115fef76f]
to [fb6d9bbd39].
︙ | | |
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
|
+
+
+
|
;;======================================================================
(use regex regex-case matchable) ;; directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
(if toppath
(let ((cfname (conc toppath "/" configname)))
|
︙ | | |
Modified dashboard-context-menu.scm
from [48947370a7]
to [4ebbf2ae46].
︙ | | |
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
+
+
+
|
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (dboard:launch-testpanel run-id test-id)
(let* ((dboardexe (common:find-local-megatest "dashboard"))
|
︙ | | |
Modified dashboard-guimonitor.scm
from [9920d4908c]
to [8b202da860].
︙ | | |
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
|
+
+
+
|
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-guimonitor))
(declare (uses common))
(declare (uses keys))
(declare (uses db))
(declare (uses tasks))
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(define (control-panel db tdb keys)
|
︙ | | |
Modified dashboard-tests.scm
from [237d160a6c]
to [0de4378c1e].
︙ | | |
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
+
+
+
|
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
;;======================================================================
;; C O M M O N
|
︙ | | |
Modified dashboard.scm
from [935bf4d2df]
to [87bb22170c].
︙ | | |
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
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
|
+
+
+
+
+
+
+
+
-
+
|
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
;; (declare (uses dashboard-main))
(declare (uses mt))
(declare (uses commonmod))
(import commonmod)
(declare (uses commonmod.import))
(declare (uses dcommonmod))
(import dcommonmod)
(declare (uses dcommonmod.import))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
;; (include "megatest-fossil-hash.scm")
(include "vg_records.scm")
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2017
|
︙ | | |
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
|
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (if (not (args:get-arg "-use-db-cache"))
;; (begin
;; (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;; (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;;)
;; data common to all tabs goes here
;; data common to all tabs in dboard:commondat struct moved to dcommonmod
;;
(defstruct dboard:commondat
((curr-tab-num 0) : number)
please-update
tabdats
update-mutex
updaters
updating
uidat ;; needs to move to tabdat at some time
hide-not-hide-tabs
)
(define (dboard:commondat-make)
(make-dboard:commondat
curr-tab-num: 0
tabdats: (make-hash-table)
please-update: #t
update-mutex: (make-mutex)
updaters: (make-hash-table)
updating: #f
hide-not-hide-tabs: #f
))
;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary)
;;
(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
(let* ((tnum (or tab-num
(dboard:commondat-curr-tab-num commondat)
0)) ;; tab-num value is curr-tab-num value in passed commondat
|
︙ | | |
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
-
+
-
+
|
(let* ((tnum (or tab-num
(dboard:commondat-curr-tab-num commondat)))
(curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '())))
(hash-table-set! (dboard:commondat-updaters commondat)
tnum
(cons updater curr-updaters))))
;; data for each specific tab goes here
;; data for each specific tab goes here - moved into dcommonmod
;;
(defstruct dboard:tabdat
#;(defstruct dboard:tabdat
;; runs
((allruns '()) : list) ;; list of dboard:rundat records
((allruns-by-id (make-hash-table)) : hash-table) ;; hash of run-id -> dboard:rundat records
((done-runs '()) : list) ;; list of runs already drawn
((not-done-runs '()) : list) ;; list of runs not yet drawn
(header #f) ;; header for decoding the run records
(keys #f) ;; keys for this run (i.e. target components)
|
︙ | | |
349
350
351
352
353
354
355
356
357
358
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
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
|
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
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
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
|
;; runs summary view
tests-tree ;; used in newdashboard
)
;; register tabdat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* TABDAT:
(cons dboard:tabdat?
(lambda (tabdat-item)
(filter
(lambda (alist-entry)
(member (car alist-entry)
'(allruns-by-id allruns))) ;; FIELDS OF INTEREST
(dboard:tabdat->alist tabdat-item)))))
;; (hash-table-set! *BBpp_custom_expanders_list* TABDAT:
;; (cons dboard:tabdat?
;; (lambda (tabdat-item)
;; (filter
;; (lambda (alist-entry)
;; (member (car alist-entry)
;; '(allruns-by-id allruns))) ;; FIELDS OF INTEREST
;; (dboard:tabdat->alist tabdat-item)))))
(define (dboard:tabdat-target-string vec)
(let ((targ (dboard:tabdat-target vec)))
(if (list? targ)(string-intersperse targ "/") "no-target-specified")))
(define (dboard:tabdat-test-patts-use vec)
(let ((val (dboard:tabdat-test-patts vec)))(if val val ""))) ;;RADT => What is the if for?
;; additional setters for dboard:data
(define (dboard:tabdat-test-patts-set!-use vec val)
(dboard:tabdat-test-patts-set! vec (if (equal? val "") #f val)))
(define (dboard:tabdat-make-data)
(let ((dat (make-dboard:tabdat)))
(dboard:tabdat-runs-btn-height-set! dat (or (configf:lookup *configdat* "dashboard" "btn-height") "x16")) ;; was 12
(dboard:tabdat-runs-btn-fontsz-set! dat (or (configf:lookup *configdat* "dashboard" "btn-fontsz") "10")) ;; was 8
(dboard:tabdat-runs-cell-width-set! dat (or (configf:lookup *configdat* "dashboard" "cell-width") "50")) ;; was 50
(dboard:tabdat-numruns-set! dat (string->number (or (args:get-arg "-cols")
(configf:lookup *configdat* "dashboard" "cols")
"8")))
(dboard:tabdat-access-mode-set! dat (db:get-access-mode)) ;; use cached db or not
(dboard:setup-tabdat dat)
(dboard:setup-num-rows dat)
dat))
(define (dboard:setup-tabdat tabdat)
(dboard:tabdat-dbdir-set! tabdat (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path))
(dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))
;; HACK ALERT: this is a hack, please fix.
(dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
(dboard:tabdat-keys-set! tabdat (rmt:get-keys))
(dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
(dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%"))
)
;; RADT => Matrix defstruct addition
(defstruct dboard:graph-dat
#;(defstruct dboard:graph-dat
((id #f) : string)
((color #f) : vector)
((flag #t) : boolean)
((cell #f) : number)
)
;; data for runs, tests etc. was used in run summary?
;;
(defstruct dboard:runsdat
#;(defstruct dboard:runsdat
;; new system
runs-index ;; target/runname => colnum
tests-index ;; testname/itempath => rownum
matrix-dat ;; vector of vectors rows/cols
)
(define (dboard:runsdat-make-init)
(make-dboard:runsdat
runs-index: (make-hash-table)
tests-index: (make-hash-table)
matrix-dat: (make-sparse-array)))
;; used to keep the rundata from rmt:get-tests-for-run
;; in sync.
;;
(defstruct dboard:rundat
#;(defstruct dboard:rundat
run
tests-drawn ;; list of id's already drawn on screen
tests-notdrawn ;; list of id's NOT already drawn
rowsused ;; hash of lists covering what areas used - replace with quadtree
hierdat ;; put hierarchial sorted list here
tests ;; hash of id => testdat
((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
|
︙ | | |
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
|
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
status
start-time
duration
)
;; register dboard:rundat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
(cons dboard:rundat?
(lambda (tabdat-item)
(filter
(lambda (alist-entry)
(member (car alist-entry)
'(run run-data-offset ))) ;; FIELDS OF INTEREST
(dboard:rundat->alist tabdat-item)))))
;; (hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
;; (cons dboard:rundat?
;; (lambda (tabdat-item)
;; (filter
;; (lambda (alist-entry)
;; (member (car alist-entry)
;; '(run run-data-offset ))) ;; FIELDS OF INTEREST
;; (dboard:rundat->alist tabdat-item)))))
(define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f));; -100 is before time began
(make-dboard:rundat
run: run
|
︙ | | |
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
|
-
+
|
(if t-sort
(cadr t-sort)
3)))
(define (get-curr-sort)
(vector-ref *tests-sort-options* *tests-sort-reverse*))
(debug:setup)
(common:debug-setup)
;; (define uidat #f)
(define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))
|
︙ | | |
Modified db.scm
from [f2d817bbad]
to [403e3c3554].
︙ | | |
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
|
+
+
+
|
(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(define *number-of-writes* 0)
|
︙ | | |
Modified dcommon.scm
from [dbcf309f44]
to [35ed13ca5b].
︙ | | |
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
+
+
+
+
+
+
+
|
(import canvas-draw-iup)
(use regex typed-records matchable)
(declare (unit dcommon))
(declare (uses gutils))
(declare (uses db))
(declare (uses commonmod))
(import commonmod)
(declare (uses dcommonmod))
(import dcommonmod)
;; (declare (uses synchash))
(include "megatest-version.scm")
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
|
︙ | | |
Added dcommonmod.scm version [751a530ad5].