242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(begin
(sqlite3:execute db "PRAGMA synchronous = FULL;")
(debug:print 0 "Initialized test database " dbpath)
(db:testdb-initialize db)))
;; (sqlite3:execute db "PRAGMA synchronous = 0;")
(debug:print-info 11 "open-test-db END (sucessful)" testpath)
db)
(begin
(debug:print-info 11 "open-test-db END (unsucessful)" testpath)
#f)))
|
|
|
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(begin
(sqlite3:execute db "PRAGMA synchronous = FULL;")
(debug:print-info 11 "Initialized test database " dbpath)
(db:testdb-initialize db)))
;; (sqlite3:execute db "PRAGMA synchronous = 0;")
(debug:print-info 11 "open-test-db END (sucessful)" testpath)
db)
(begin
(debug:print-info 11 "open-test-db END (unsucessful)" testpath)
#f)))
|
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000)))) ;; 136000)))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(begin
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT);")
(sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
db))
(define (db:log-event . loglst)
(let ((db (open-logging-db))
(logline (apply conc loglst)))
(sqlite3:execute db "INSERT INTO log (logline) VALUES (?);" logline)
(sqlite3:finalize! db)
logline))
;;======================================================================
;; TODO:
;; put deltas into an assoc list with version numbers
;; apply all from last to current
|
|
|
|
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000)))) ;; 136000)))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(begin
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
(sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
db))
(define (db:log-event . loglst)
(let ((db (open-logging-db))
(logline (apply conc loglst)))
(sqlite3:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);" logline (current-directory)(string-intersperse (argv) " ")(current-process-id))
(sqlite3:finalize! db)
logline))
;;======================================================================
;; TODO:
;; put deltas into an assoc list with version numbers
;; apply all from last to current
|
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
|
(sqlite3:finalize! tdb)
;; Now rollup the counts to the central megatest.db
(rdb:pass-fail-counts test-id fail-count pass-count)
;; (sqlite3:execute db "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;"
;; fail-count pass-count test-id)
(thread-sleep! 10) ;; play nice with the queue by ensuring the rollup is at least 10s later than the set
;; if the test is not FAIL then set status based on the fail and pass counts.
(rdb:test-rollup-test_data-pass-fail test-id)
;; (sqlite3:execute
;; db ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME
;; "UPDATE tests
;; SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0
|
|
|
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
|
(sqlite3:finalize! tdb)
;; Now rollup the counts to the central megatest.db
(rdb:pass-fail-counts test-id fail-count pass-count)
;; (sqlite3:execute db "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;"
;; fail-count pass-count test-id)
(thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least 10ms later than the set
;; if the test is not FAIL then set status based on the fail and pass counts.
(rdb:test-rollup-test_data-pass-fail test-id)
;; (sqlite3:execute
;; db ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME
;; "UPDATE tests
;; SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0
|