Megatest

Diff
Login

Differences From Artifact [575d5c7ba8]:

To Artifact [6d49ce2a57]:


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))
	     (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 "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:"))))
	     (tdb-writeable       (and (file-write-access? work-area)
				       (file-write-access? dbpath)))
	     (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					       (string->number (args:get-arg "-override-timeout"))
					       136000))))
	
	(if (and tdb-writeable
		 *db-write-access*)
	    (sqlite3:set-busy-handler! db handler))
	(if (not dbexists)
	    (begin
	      (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
	      (debug:print-info 11 "Initialized test database " dbpath)
	      (tdb:testdb-initialize db)))
	;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	(debug:print-info 11 "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 "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 "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)