db: clean up test suite, (test conditional) => (conditional test), timing

collects/tests/db/all-tests.rkt

@@ -250,5 +250,5 @@ Testing profiles are flattened, not hierarchical.
          [else
           (for ([test tests])
             (printf "Running ~s tests\n" (car test))
-            (run-tests (cdr test))
+            (time (run-tests (cdr test)))
             (newline))])))

collects/tests/db/config.rkt

@@ -27,6 +27,7 @@
    set-equal?
    sql
    select-val
+   dbsystem
    NOISY?
    TESTFLAGS
    ANYFLAGS))
@@ -88,6 +89,14 @@
            (sql (string-append "values (" str ")"))]
           [else (sql (string-append "select " str))]))
 
+  (define dbsystem
+    (with-handlers ([(lambda (e) #t)
+                     (lambda (e) #f)])
+      (let* ([c (connect)]
+             [dbsystem (send c get-dbsystem)])
+        (disconnect c)
+        dbsystem)))
+
   ;; Flags = dbflags U dbsys
 
   ;; Returns #t if all are set.

collects/tests/db/db/concurrent.rkt

@@ -7,8 +7,8 @@
 (export test^)
 
 (define (test-concurrency workers)
-  (test-case (format "lots of threads (~s)" workers)
-    (unless (ANYFLAGS 'isora 'isdb2)
+  (unless (ANYFLAGS 'isora 'isdb2)
+    (test-case (format "lots of threads (~s)" workers)
       (call-with-connection
        (lambda (c)
          (query-exec c "create temporary table play_numbers (n integer)")
@@ -40,8 +40,8 @@
             (query-value c "select max(n) from play_numbers"))))
 
 (define (kill-safe-test proxy?)
-  (test-case (format "kill-safe test~a" (if proxy? " (proxy)" ""))
-    (unless (ANYFLAGS 'isora 'isdb2)
+  (unless (ANYFLAGS 'isora 'isdb2)
+    (test-case (format "kill-safe test~a" (if proxy? " (proxy)" ""))
     (call-with-connection
      (lambda (c0)
        (let ([c (if proxy?
@@ -63,8 +63,8 @@
            (sync t))))))))
 
 (define (async-test)
-  (test-case "asynchronous execution"
-    (unless (ANYFLAGS 'ismy 'isora 'isdb2)
+  (unless (ANYFLAGS 'ismy 'isora 'isdb2)
+    (test-case "asynchronous execution"
       (call-with-connection
        (lambda (c)
          (query-exec c "create temporary table nums (n integer)")

collects/tests/db/db/query.rkt

@@ -33,8 +33,8 @@
 
   (test-suite (format "simple (~a)" prep-mode)
 
-    (test-case "query-exec"
-      (unless (ANYFLAGS 'isora 'isdb2) ;; table isn't temp, so don't tamper with it
+    (unless (ANYFLAGS 'isora 'isdb2) ;; table isn't temp, so don't tamper with it
+      (test-case "query-exec"
         (with-connection c
           (check-pred void? (Q c query-exec "insert into the_numbers values(-1, 'mysterious')"))
           (check-equal? (Q c query-value "select descr from the_numbers where N = -1")
@@ -143,8 +143,8 @@
           (check set-equal?
                  (map vector (map car test-data))
                  (rows-result-rows q)))))
-    (test-case "query - update"
-      (unless (ANYFLAGS 'isora 'isdb2)
+    (unless (ANYFLAGS 'isora 'isdb2)
+      (test-case "query - update"
         (with-connection c
           (let [(q (query c "update the_numbers set N = -1 where N = 1"))]
             (check-pred simple-result? q)))))
@@ -226,8 +226,8 @@
 
     ;; Added 18 May 2003: Corrected a bug which incorrectly interleaved
     ;; nulls with returned fields.
-    (test-case "nulls arrive in correct order"
-      (unless (TESTFLAGS 'odbc 'issl)
+    (unless (TESTFLAGS 'odbc 'issl)
+      (test-case "nulls arrive in correct order"
         (with-connection c
           ;; raw NULL has PostgreSQL type "unknown", not allowed
           (define (clean . strs)
@@ -257,8 +257,8 @@
     (test-case "query - not a statement"
       (with-connection c
         (check-exn exn:fail? (lambda () (query c 5)))))
-    (test-case "query - multiple statements in string"
-      (unless (or (TESTFLAGS 'odbc 'ispg) (ANYFLAGS 'isdb2))
+    (unless (or (TESTFLAGS 'odbc 'ispg) (ANYFLAGS 'isdb2))
+      (test-case "query - multiple statements in string"
         (with-connection c
           (check-exn exn:fail?
                      (lambda ()

collects/tests/db/db/sql-types.rkt

@@ -12,8 +12,6 @@
 (import config^ database^)
 (export test^)
 
-(define dbsystem #f) ;; hack, set within test suite
-
 (define current-type (make-parameter #f))
 
 (define-syntax-rule (type-test-case types . body)
@@ -23,10 +21,9 @@
   (let* ([known-types (send dbsystem get-known-types)]
          [type (for/or ([type types])
                 (and (member type known-types) type))])
-    (if type
-        (test-case (format "~s" type)
-          (parameterize ((current-type type)) (proc)))
-        (test-case (format "unsupported: ~s" types) (void)))))
+    (when type
+      (test-case (format "~s" type)
+        (parameterize ((current-type type)) (proc))))))
 
 (define (check-timestamptz-equal? a b)
   (check srfi:time=?
@@ -143,11 +140,6 @@
 
 (define test
   (test-suite "SQL types (roundtrip, etc)"
-    #:before (lambda ()
-               (call-with-connection
-                (lambda (c) (set! dbsystem (connection-dbsystem c)))))
-    #:after (lambda () (set! dbsystem #f))
-
     (type-test-case '(bool boolean)
       (call-with-connection
        (lambda (c)
@@ -205,8 +197,8 @@
            (check-roundtrip c -inf.0)
            (check-roundtrip c +nan.0)))))
 
-    (type-test-case '(numeric decimal)
-      (unless (ANYFLAGS 'isdb2) ;; "Driver not capable"
+    (unless (ANYFLAGS 'isdb2) ;; "Driver not capable"
+      (type-test-case '(numeric decimal)
         (call-with-connection
          (lambda (c)
            (check-roundtrip c 0)