Overview
Context
Changes
Modified archivemod.scm
from [f8a6de6075]
to [1c0f8e1665].
︙ | | |
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
-
+
|
;; (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))
;;
;; (include "common_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
;;
;;======================================================================
;;
;;======================================================================
;; NOT CURRENTLY USED
;;
|
︙ | | |
Modified common_records.scm
from [9a86cd2d43]
to [9505f2c8b8].
︙ | | |
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
|
65
66
67
68
69
70
71
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
(print-call-chain (current-error-port))
(with-output-to-port (current-error-port)
(lambda ()
(print ((condition-property-accessor 'exn 'message) exn))
(print "Callback error in " procname)
(print "Full condition info:\n" (condition->list exn)))))
(proc)))
;; ;; 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)))
;;
;; ;; 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)
;; )))))
;;
;;
;;
;; ;; 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 [1142c0775a]
to [2c1167f0dc].
︙ | | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
+
|
;; config file utils
;; misc conversion, data manipulation functions
;; testsuite and area utilites
;;
;;======================================================================
(include "megatest-fossil-hash.scm")
(include "db_records.scm")
;; these come from processmod
;;
;; (define setenv set-environment-variable!)
;; (define unsetenv unset-environment-variable!)
;; (define getenv get-environment-variable)
|
︙ | | |
Modified db_records.scm
from [b1c479de82]
to [fefce42cd2].
︙ | | |
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
|
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
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (dbr:dbstruct-path-set! v path)
;; (dbr:dbstruct-local-set! v local)
;; (dbr:dbstruct-locdbs-set! v (make-hash-table))
;; v))
(define (make-db:test)(make-vector 20))
(define-inline (db:test-get-id vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id vec) (vector-ref vec 1))
(define-inline (db:test-get-testname vec) (vector-ref vec 2))
(define-inline (db:test-get-state vec) (vector-ref vec 3))
(define-inline (db:test-get-status vec) (vector-ref vec 4))
(define-inline (db:test-get-event_time vec) (vector-ref vec 5))
(define-inline (db:test-get-host vec) (vector-ref vec 6))
(define-inline (db:test-get-cpuload vec) (vector-ref vec 7))
(define-inline (db:test-get-diskfree vec) (vector-ref vec 8))
(define-inline (db:test-get-uname vec) (vector-ref vec 9))
;; (define-inline (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10)))
(define-inline (db:test-get-rundir vec) (vector-ref vec 10))
(define-inline (db:test-get-item-path vec) (vector-ref vec 11))
(define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
(define-inline (db:test-get-final_logf vec) (vector-ref vec 13))
(define-inline (db:test-get-comment vec) (vector-ref vec 14))
(define-inline (db:test-get-process_id vec) (vector-ref vec 16))
(define-inline (db:test-get-archived vec) (vector-ref vec 17))
(define-inline (db:test-get-last_update vec) (vector-ref vec 18))
(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-inline (db:test-get-pass_count vec) (vector-ref vec 15))
;; (define-inline (db:test-get-fail_count vec) (vector-ref vec 16))
(define-inline (db:test-get-fullname vec)
;; (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-inline (db:test-get-first_err vec) (printable (vector-ref vec 15)))
(define-inline (db:test-get-first_warn vec) (printable (vector-ref vec 16))) ;; RADT => reference 16 is repeated
(define (db:test-get-first_err vec) (conc #;printable (vector-ref vec 15)))
(define (db:test-get-first_warn vec) (conc #;printable (vector-ref vec 16))) ;; RADT => reference 16 is repeated
(define-inline (db:test-set-cpuload! vec val)(vector-set! vec 7 val))
(define-inline (db:test-set-diskfree! vec val)(vector-set! vec 8 val))
(define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define-inline (db:test-set-state! vec val)(vector-set! vec 3 val))
(define-inline (db:test-set-status! vec val)(vector-set! vec 4 val))
(define-inline (db:test-set-run_duration! vec val)(vector-set! vec 12 val))
(define-inline (db:test-set-final_logf! vec val)(vector-set! vec 13 val))
(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-inline (db:mintest-get-id vec) (vector-ref vec 0))
(define-inline (db:mintest-get-run_id vec) (vector-ref vec 1))
(define-inline (db:mintest-get-testname vec) (vector-ref vec 2))
(define-inline (db:mintest-get-state vec) (vector-ref vec 3))
(define-inline (db:mintest-get-status vec) (vector-ref vec 4))
(define-inline (db:mintest-get-event_time vec) (vector-ref vec 5))
(define-inline (db:mintest-get-item_path vec) (vector-ref vec 6))
(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-inline (db:testmeta-get-id vec) (vector-ref vec 0))
(define-inline (db:testmeta-get-testname vec) (vector-ref vec 1))
(define-inline (db:testmeta-get-author vec) (vector-ref vec 2))
(define-inline (db:testmeta-get-owner vec) (vector-ref vec 3))
(define-inline (db:testmeta-get-description vec) (vector-ref vec 4))
(define-inline (db:testmeta-get-reviewed vec) (vector-ref vec 5))
(define-inline (db:testmeta-get-iterated vec) (vector-ref vec 6))
(define-inline (db:testmeta-get-avg_runtime vec) (vector-ref vec 7))
(define-inline (db:testmeta-get-avg_disk vec) (vector-ref vec 8))
(define-inline (db:testmeta-get-tags vec) (vector-ref vec 9))
(define-inline (db:testmeta-set-id! vec val)(vector-set! vec 0 val))
(define-inline (db:testmeta-set-testname! vec val)(vector-set! vec 1 val))
(define-inline (db:testmeta-set-author! vec val)(vector-set! vec 2 val))
(define-inline (db:testmeta-set-owner! vec val)(vector-set! vec 3 val))
(define-inline (db:testmeta-set-description! vec val)(vector-set! vec 4 val))
(define-inline (db:testmeta-set-reviewed! vec val)(vector-set! vec 5 val))
(define-inline (db:testmeta-set-iterated! vec val)(vector-set! vec 6 val))
(define-inline (db:testmeta-set-avg_runtime! vec val)(vector-set! vec 7 val))
(define-inline (db:testmeta-set-avg_disk! vec val)(vector-set! vec 8 val))
(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-inline (db:test-data-get-id vec) (vector-ref vec 0))
(define-inline (db:test-data-get-test_id vec) (vector-ref vec 1))
(define-inline (db:test-data-get-category vec) (vector-ref vec 2))
(define-inline (db:test-data-get-variable vec) (vector-ref vec 3))
(define-inline (db:test-data-get-value vec) (vector-ref vec 4))
(define-inline (db:test-data-get-expected vec) (vector-ref vec 5))
(define-inline (db:test-data-get-tol vec) (vector-ref vec 6))
(define-inline (db:test-data-get-units vec) (vector-ref vec 7))
(define-inline (db:test-data-get-comment vec) (vector-ref vec 8))
(define-inline (db:test-data-get-status vec) (vector-ref vec 9))
(define-inline (db:test-data-get-type vec) (vector-ref vec 10))
(define-inline (db:test-data-get-last_update vec) (vector-ref vec 11))
(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-inline (db:test-data-set-id! vec val)(vector-set! vec 0 val))
(define-inline (db:test-data-set-test_id! vec val)(vector-set! vec 1 val))
(define-inline (db:test-data-set-category! vec val)(vector-set! vec 2 val))
(define-inline (db:test-data-set-variable! vec val)(vector-set! vec 3 val))
(define-inline (db:test-data-set-value! vec val)(vector-set! vec 4 val))
(define-inline (db:test-data-set-expected! vec val)(vector-set! vec 5 val))
(define-inline (db:test-data-set-tol! vec val)(vector-set! vec 6 val))
(define-inline (db:test-data-set-units! vec val)(vector-set! vec 7 val))
(define-inline (db:test-data-set-comment! vec val)(vector-set! vec 8 val))
(define-inline (db:test-data-set-status! vec val)(vector-set! vec 9 val))
(define-inline (db:test-data-set-type! vec val)(vector-set! vec 10 val))
(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-inline (tdb:step-get-id vec) (vector-ref vec 0))
(define-inline (tdb:step-get-test_id vec) (vector-ref vec 1))
(define-inline (tdb:step-get-stepname vec) (vector-ref vec 2))
(define-inline (tdb:step-get-state vec) (vector-ref vec 3))
(define-inline (tdb:step-get-status vec) (vector-ref vec 4))
(define-inline (tdb:step-get-event_time vec) (vector-ref vec 5))
(define-inline (tdb:step-get-logfile vec) (vector-ref vec 6))
(define-inline (tdb:step-get-comment vec) (vector-ref vec 7))
(define-inline (tdb:step-get-last_update vec) (vector-ref vec 8))
(define-inline (tdb:step-set-id! vec val)(vector-set! vec 0 val))
(define-inline (tdb:step-set-test_id! vec val)(vector-set! vec 1 val))
(define-inline (tdb:step-set-stepname! vec val)(vector-set! vec 2 val))
(define-inline (tdb:step-set-state! vec val)(vector-set! vec 3 val))
(define-inline (tdb:step-set-status! vec val)(vector-set! vec 4 val))
(define-inline (tdb:step-set-event_time! vec val)(vector-set! vec 5 val))
(define-inline (tdb:step-set-logfile! vec val)(vector-set! vec 6 val))
(define-inline (tdb:step-set-comment! vec val)(vector-set! vec 7 val))
(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-inline (tdb:steps-table-get-stepname vec) (vector-ref vec 0))
(define-inline (tdb:steps-table-get-start vec) (vector-ref vec 1))
(define-inline (tdb:steps-table-get-end vec) (vector-ref vec 2))
(define-inline (tdb:steps-table-get-status vec) (vector-ref vec 3))
(define-inline (tdb:steps-table-get-runtime vec) (vector-ref vec 4))
(define-inline (tdb:steps-table-get-log-file vec) (vector-ref vec 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-inline (tdb:step-stable-set-stepname! vec val)(vector-set! vec 0 val))
(define-inline (tdb:step-stable-set-start! vec val)(vector-set! vec 1 val))
(define-inline (tdb:step-stable-set-end! vec val)(vector-set! vec 2 val))
(define-inline (tdb:step-stable-set-status! vec val)(vector-set! vec 3 val))
(define-inline (tdb:step-stable-set-runtime! vec val)(vector-set! vec 4 val))
(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-inline (cdb:packet-get-client-sig vec) (vector-ref vec 0))
(define-inline (cdb:packet-get-qtype vec) (vector-ref vec 1))
(define-inline (cdb:packet-get-immediate vec) (vector-ref vec 2))
(define-inline (cdb:packet-get-query-sig vec) (vector-ref vec 3))
(define-inline (cdb:packet-get-params vec) (vector-ref vec 4))
(define-inline (cdb:packet-get-qtime vec) (vector-ref vec 5))
(define-inline (cdb:packet-set-client-sig! vec val)(vector-set! vec 0 val))
(define-inline (cdb:packet-set-qtype! vec val)(vector-set! vec 1 val))
(define-inline (cdb:packet-set-immediate! vec val)(vector-set! vec 2 val))
(define-inline (cdb:packet-set-query-sig! vec val)(vector-set! vec 3 val))
(define-inline (cdb:packet-set-params! vec val)(vector-set! vec 4 val))
(define-inline (cdb:packet-set-qtime! vec val)(vector-set! vec 5 val))
(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 [dc7e97c759]
to [8a7fea8aaf].
︙ | | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
-
+
|
;; (declare (uses keys))
;; (declare (uses ods))
;; (declare (uses client))
;; (declare (uses mt))
;;
;; (include "common_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
(include "key_records.scm")
;; (include "run_records.scm")
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)
;;======================================================================
|
︙ | | |
Modified ezstepsmod.scm
from [c2dd1003d3]
to [d9ce0e65b9].
︙ | | |
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
-
+
|
;; (declare (uses items))
;; (declare (uses runconfig))
;; ;; (declare (uses sdb))
;; ;; (declare (uses filedb))
;;
;; (include "common_records.scm")
;; (include "key_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
;; (include "run_records.scm")
;;
;;
;;(rmt:get-test-info-by-id run-id test-id) -> testdat
(define message-window #f)
|
︙ | | |
Modified http-transportmod.scm
from [194fbe34ee]
to [68352bdfd6].
︙ | | |
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
-
+
|
;; (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
;; (declare (uses server))
;; ;; (declare (uses daemon))
;; (declare (uses portlogger))
;; (declare (uses rmt))
;;
;; (include "common_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
;; (include "js-path.scm")
;; (require-library stml)
(define (http-transport:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
|
︙ | | |
Modified launchmod.scm
from [1c5a69d4fb]
to [90e4e1ba80].
︙ | | |
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
-
+
|
processmod
rmtmod
servermod
subrunmod
testsmod
)
(include "db_records.scm")
;; (include "db_records.scm")
(include "key_records.scm")
;;======================================================================
;; ezsteps
;;======================================================================
;; ezsteps were going to be coded as
|
︙ | | |
Modified megatest.scm
from [97792d486c]
to [9175824e00].
︙ | | |
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
-
-
-
+
-
+
|
;; tasksmod
testsmod
)
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(define setenv set-environment-variable!)
(define unsetenv unset-environment-variable!)
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
;; (include "common_records.scm")
;; (include "key_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
;; (include "test_records.scm")
(include "common.scm")
(include "db.scm")
(include "server.scm")
(include "tests.scm")
|
︙ | | |
Modified mtmod.scm
from [0faea80728]
to [961c38c9fc].
︙ | | |
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
-
+
|
;; (declare (uses server))
;; (declare (uses runs))
;; (declare (uses rmt))
;; ;; (declare (uses filedb))
;;
;; (include "common_records.scm")
;; (include "key_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
;; (include "run_records.scm")
;; (include "test_records.scm")
;; This is the Megatest API. All generally "useful" routines will be wrapped or extended
;; here.
(define (mt:discard-blocked-tests run-id failed-test tests test-records)
|
︙ | | |
Modified rmtmod.scm
from [625e964a73]
to [ce483e1308].
︙ | | |
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
-
+
|
)
(defstruct alldat
(areapath #f)
(ulexdat #f)
)
(include "db_records.scm")
;; (include "db_records.scm")
;;======================================================================
;; return the handle struct for sending queries to a specific database
;; - initializes the connection object if this is the first access
;; - finds the "captain" and asks who to talk to for the given dbfname
;; - establishes the connection to the current dbowner
;;
|
︙ | | |
Modified runsmod.scm
from [2690188456]
to [af3c8fc3d0].
︙ | | |
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
-
+
|
launchmod
subrunmod
servermod
itemsmod
)
(include "db_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(include "key_records.scm")
;; use this struct to facilitate refactoring
;;
|
︙ | | |
Modified tasksmod.scm
from [a2cb242f3c]
to [04ec90a3d8].
︙ | | |
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
-
+
|
;; (declare (uses rmt))
;; (declare (uses common))
;; (declare (uses pgdb))
;; (import pgdb) ;; pgdb is a module
(include "task_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
;;======================================================================
;; Tasks db
;;======================================================================
;; wait up to aprox n seconds for a journal to go away
;;
|
︙ | | |
Modified testsmod.scm
from [f755d84d12]
to [4c8938f16a].
︙ | | |
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
-
+
|
;;
;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
;; (import (prefix sqlite3 sqlite3:))
;; (require-library stml)
;;
;; (include "common_records.scm")
;; (include "key_records.scm")
(include "db_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(include "js-path.scm")
(define (init-java-script-lib)
(set! *java-script-lib* (conc (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))
)
|
︙ | | |