43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
|
;; Create the sqlite db for the individual test(s)
(define (open-test-db work-area)
(debug:print-info 11 "open-test-db " work-area)
(if (and work-area
(directory? work-area)
(file-read-access? work-area))
(let* ((dbpath (conc work-area "/testdat.db"))
(tdb-writeable (file-write-access? dbpath))
(let* ((dbpath (conc work-area "/testdat.db"))
(dbexists (file-exists? dbpath))
(work-area-writeable (file-write-access? work-area))
(dbexists (file-exists? dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
((condition-property-accessor 'exn 'message) exn))
(set! db (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access
(set! dbexists #f)) ;; must force re-creation of tables, more tom-foolery
(set! db (sqlite3:open-database dbpath)))
(if *db-write-access* (sqlite3:set-busy-handler! db handler))
(debug:print-info 11 "open-test-db END (unsucessful)" work-area)
;; provide an in-mem db (this is dangerous!)
(tdb:testdb-initialize baddb)
baddb)))
(debug:print-info 11 "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 "TEST PATH: " test-path)
|