Megatest

Diff
Login

Differences From Artifact [7319c89ae9]:

To Artifact [a315d29022]:


54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
54
55
56
57
58
59
60

61
62
63
64
65
66
67
68







-
+







      (let* ((dbpath              (conc work-area "/testdat.db"))
	     (dbexists            (file-exists? dbpath))
	     (work-area-writeable (file-write-access? work-area))
	     (db                  (handle-exceptions  ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem
				   exn
				   (begin
				     (print-call-chain (current-error-port))
				     (debug:print 2 #f "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
				     (debug:print 2 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
						  ((condition-property-accessor 'exn 'message) exn))
				     (set! dbexists #f) ;; must force re-creation of tables, more tom-foolery
				     (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access 
				   (if (or work-area-writeable
					   dbexists)
				       (sqlite3:open-database dbpath)
				       (sqlite3:open-database ":memory:"))))
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
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







-
+



















-
+







-
+











-
+







	;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	(debug:print-info 11 #f "open-test-db END (sucessful)" work-area)
	;; now let's test that everything is correct
	(handle-exceptions
	 exn
	 (begin
	   (print-call-chain (current-error-port))
	   (debug:print 0 #f "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file " 
	   (debug:print 0 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file " 
			dbpath ".\n  "
			((condition-property-accessor 'exn 'message) exn))
	   #f)
	 ;; Is there a cheaper single line operation that will check for existance of a table
	 ;; and raise an exception ?
	 (sqlite3:execute db "SELECT id FROM test_data LIMIT 1;"))
	db)
      ;; no work-area or not readable - create a placeholder to fake rest of world out
      (let ((baddb (sqlite3:open-database ":memory:")))
 	(debug:print-info 11 #f "open-test-db END (unsucessful)" work-area)
 	;; provide an in-mem db (this is dangerous!)
 	(tdb:testdb-initialize baddb)
 	baddb)))

;; find and open the testdat.db file for an existing test
(define (tdb:open-test-db-by-test-id test-id #!key (work-area #f))
  (let* ((test-path (if work-area
			work-area
			(rmt:test-get-rundir-from-test-id test-id))))
    (debug:print 3 #f "TEST PATH: " test-path)
    (debug:print 3 *default-log-port* "TEST PATH: " test-path)
    (open-test-db test-path)))

;; find and open the testdat.db file for an existing test
(define (tdb:open-test-db-by-test-id-local dbstruct run-id test-id #!key (work-area #f))
  (let* ((test-path (if work-area
			work-area
			(db:test-get-rundir-from-test-id dbstruct run-id test-id))))
    (debug:print 3 #f "TEST PATH: " test-path)
    (debug:print 3 *default-log-port* "TEST PATH: " test-path)
    (open-test-db test-path)))

;; find and open the testdat.db file for an existing test
(define (tdb:open-run-close-db-by-test-id-local dbstruct run-id test-id work-area proc . params)
  (let* ((test-path (if work-area
			work-area
			(db:test-get-rundir-from-test-id dbstruct run-id test-id)))
	 (tdb        (open-test-db test-path)))
    (apply proc tdb params)))

(define (tdb:testdb-initialize db)
  (debug:print 11 #f "db:testdb-initialize START")
  (debug:print 11 *default-log-port* "db:testdb-initialize START")
  (sqlite3:with-transaction
   db
   (lambda ()
     (for-each
      (lambda (sqlcmd)
	(sqlite3:execute db sqlcmd))
      (list "CREATE TABLE IF NOT EXISTS test_rundat (
169
170
171
172
173
174
175
176

177
178
179
180
181
182
183
169
170
171
172
173
174
175

176
177
178
179
180
181
182
183







-
+







	    ;;      the ackstate is set to 1 once the command has been completed
	    "CREATE TABLE IF NOT EXISTS test_meta (
              id INTEGER PRIMARY KEY,
              var TEXT,
              val TEXT,
              ackstate INTEGER DEFAULT 0,
              CONSTRAINT metadat_constraint UNIQUE (var));"))))
  (debug:print 11 #f "db:testdb-initialize END"))
  (debug:print 11 *default-log-port* "db:testdb-initialize END"))

;; This routine moved to db:read-test-data
;;
(define (tdb:read-test-data tdb test-id categorypatt)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status type)
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
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







-
+











-
+







;; 	'())))

;; NOTE: Run this local with #f for db !!!
(define (tdb:load-test-data run-id test-id)
  (let loop ((lin (read-line)))
    (if (not (eof-object? lin))
	(begin
	  (debug:print 4 #f lin)
	  (debug:print 4 *default-log-port* lin)
	  (rmt:csv->test-data run-id test-id lin)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status too 
  (rmt:test-data-rollup run-id test-id #f))

;; NOTE: Run this local with #f for db !!!
(define (tdb:load-logpro-data run-id test-id)
  (let loop ((lin (read-line)))
    (if (not (eof-object? lin))
	(begin
	  (debug:print 4 #f lin)
	  (debug:print 4 *default-log-port* lin)
	  (rmt:csv->test-data run-id test-id lin)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status too 
  (rmt:test-data-rollup run-id test-id #f))

(define (tdb:get-prev-tol-for-test tdb test-id category variable)
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
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







-
+





-
+

















-
+












-
+







;; 
;; NOT USED, WILL BE REMOVED
;;
(define (tdb:get-steps-table steps);; organise the steps for better readability
  (let ((res (make-hash-table)))
    (for-each 
     (lambda (step)
       (debug:print 6 #f "step=" step)
       (debug:print 6 *default-log-port* "step=" step)
       (let ((record (hash-table-ref/default 
		      res 
		      (tdb:step-get-stepname step) 
		      ;;        stepname                start end status Duration  Logfile 
		      (vector (tdb:step-get-stepname step) ""   "" ""     ""        ""))))
	 (debug:print 6 #f "record(before) = " record 
	 (debug:print 6 *default-log-port* "record(before) = " record 
		      "\nid:       " (tdb:step-get-id step)
		      "\nstepname: " (tdb:step-get-stepname step)
		      "\nstate:    " (tdb:step-get-state step)
		      "\nstatus:   " (tdb:step-get-status step)
		      "\ntime:     " (tdb:step-get-event_time step))
	 (case (string->symbol (tdb:step-get-state step))
	   ((start)(vector-set! record 1 (tdb:step-get-event_time step))
	    (vector-set! record 3 (if (equal? (vector-ref record 3) "")
				      (tdb:step-get-status step)))
	    (if (> (string-length (tdb:step-get-logfile step))
		   0)
		(vector-set! record 5 (tdb:step-get-logfile step))))
	   ((end)  
	    (vector-set! record 2 (any->number (tdb:step-get-event_time step)))
	    (vector-set! record 3 (tdb:step-get-status step))
	    (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
					(endt   (any->number (vector-ref record 2))))
				    (debug:print 4 #f "record[1]=" (vector-ref record 1) 
				    (debug:print 4 *default-log-port* "record[1]=" (vector-ref record 1) 
						 ", startt=" startt ", endt=" endt
						 ", get-status: " (tdb:step-get-status step))
				    (if (and (number? startt)(number? endt))
					(seconds->hr-min-sec (- endt startt)) "-1")))
	    (if (> (string-length (tdb:step-get-logfile step))
		   0)
		(vector-set! record 5 (tdb:step-get-logfile step))))
	   (else
	    (vector-set! record 2 (tdb:step-get-state step))
	    (vector-set! record 3 (tdb:step-get-status step))
	    (vector-set! record 4 (tdb:step-get-event_time step))))
	 (hash-table-set! res (tdb:step-get-stepname step) record)
	 (debug:print 6 #f "record(after)  = " record 
	 (debug:print 6 *default-log-port* "record(after)  = " record 
		      "\nid:       " (tdb:step-get-id step)
		      "\nstepname: " (tdb:step-get-stepname step)
		      "\nstate:    " (tdb:step-get-state step)
		      "\nstatus:   " (tdb:step-get-status step)
		      "\ntime:     " (tdb:step-get-event_time step))))
     ;; (else   (vector-set! record 1 (tdb:step-get-event_time step)))
     (sort steps (lambda (a b)
305
306
307
308
309
310
311
312

313
314
315
316
317
318

319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336

337
338
339
340
341
342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
305
306
307
308
309
310
311

312
313
314
315
316
317

318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335

336
337
338
339
340
341
342
343
344
345
346
347
348

349
350
351
352
353
354
355
356







-
+





-
+

















-
+












-
+







;; get a pretty table to summarize steps
;;
(define (tdb:get-steps-table-list steps)
  ;; organise the steps for better readability
  (let ((res (make-hash-table)))
    (for-each 
     (lambda (step)
       (debug:print 6 #f "step=" step)
       (debug:print 6 *default-log-port* "step=" step)
       (let ((record (hash-table-ref/default 
		      res 
		      (tdb:step-get-stepname step) 
		      ;;        stepname                start end status    
		      (vector (tdb:step-get-stepname step) ""   "" ""     "" ""))))
	 (debug:print 6 #f "record(before) = " record 
	 (debug:print 6 *default-log-port* "record(before) = " record 
		      "\nid:       " (tdb:step-get-id step)
		      "\nstepname: " (tdb:step-get-stepname step)
		      "\nstate:    " (tdb:step-get-state step)
		      "\nstatus:   " (tdb:step-get-status step)
		      "\ntime:     " (tdb:step-get-event_time step))
	 (case (string->symbol (tdb:step-get-state step))
	   ((start)(vector-set! record 1 (tdb:step-get-event_time step))
	    (vector-set! record 3 (if (equal? (vector-ref record 3) "")
				      (tdb:step-get-status step)))
	    (if (> (string-length (tdb:step-get-logfile step))
		   0)
		(vector-set! record 5 (tdb:step-get-logfile step))))
	   ((end)  
	    (vector-set! record 2 (any->number (tdb:step-get-event_time step)))
	    (vector-set! record 3 (tdb:step-get-status step))
	    (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
					(endt   (any->number (vector-ref record 2))))
				    (debug:print 4 #f "record[1]=" (vector-ref record 1) 
				    (debug:print 4 *default-log-port* "record[1]=" (vector-ref record 1) 
						 ", startt=" startt ", endt=" endt
						 ", get-status: " (tdb:step-get-status step))
				    (if (and (number? startt)(number? endt))
					(seconds->hr-min-sec (- endt startt)) "-1")))
	    (if (> (string-length (tdb:step-get-logfile step))
		   0)
		(vector-set! record 5 (tdb:step-get-logfile step))))
	   (else
	    (vector-set! record 2 (tdb:step-get-state step))
	    (vector-set! record 3 (tdb:step-get-status step))
	    (vector-set! record 4 (tdb:step-get-event_time step))))
	 (hash-table-set! res (tdb:step-get-stepname step) record)
	 (debug:print 6 #f "record(after)  = " record 
	 (debug:print 6 *default-log-port* "record(after)  = " record 
		      "\nid:       " (tdb:step-get-id step)
		      "\nstepname: " (tdb:step-get-stepname step)
		      "\nstate:    " (tdb:step-get-state step)
		      "\nstatus:   " (tdb:step-get-status step)
		      "\ntime:     " (tdb:step-get-event_time step))))
     ;; (else   (vector-set! record 1 (tdb:step-get-event_time step)))
     (sort steps (lambda (a b)
393
394
395
396
397
398
399
400

401
393
394
395
396
397
398
399

400
401







-
+

(define (tdb:remote-update-testdat-meta-info run-id test-id work-area cpuload diskfree minutes)
  (let ((tdb         (rmt:open-test-db-by-test-id run-id test-id work-area: work-area)))
    (if (sqlite3:database? tdb)
	(begin
	  (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);"
			   cpuload diskfree minutes)
	  (sqlite3:finalize! tdb))
	(debug:print 2 #f "Can't update testdat.db for test " test-id " read-only or non-existant"))))
	(debug:print 2 *default-log-port* "Can't update testdat.db for test " test-id " read-only or non-existant"))))