From 69a56ef683e557b255de2b8a962077245b4f5955 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 31 Aug 2011 17:34:45 -0600 Subject: [PATCH] db: clean up test suite, (test conditional) => (conditional test), timing --- collects/tests/db/all-tests.rkt | 2 +- collects/tests/db/config.rkt | 9 +++++++++ collects/tests/db/db/concurrent.rkt | 12 ++++++------ collects/tests/db/db/query.rkt | 16 ++++++++-------- collects/tests/db/db/sql-types.rkt | 18 +++++------------- 5 files changed, 29 insertions(+), 28 deletions(-) diff --git a/collects/tests/db/all-tests.rkt b/collects/tests/db/all-tests.rkt index 42b1d03fe6..99cdd3055a 100644 --- a/collects/tests/db/all-tests.rkt +++ b/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))]))) diff --git a/collects/tests/db/config.rkt b/collects/tests/db/config.rkt index 434698cf6b..da69cbc88d 100644 --- a/collects/tests/db/config.rkt +++ b/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. diff --git a/collects/tests/db/db/concurrent.rkt b/collects/tests/db/db/concurrent.rkt index 0f25a08de7..a051a580c1 100644 --- a/collects/tests/db/db/concurrent.rkt +++ b/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)") diff --git a/collects/tests/db/db/query.rkt b/collects/tests/db/db/query.rkt index e404c40cb6..c396daf566 100644 --- a/collects/tests/db/db/query.rkt +++ b/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 () diff --git a/collects/tests/db/db/sql-types.rkt b/collects/tests/db/db/sql-types.rkt index 402de55fb4..ed42b49fbc 100644 --- a/collects/tests/db/db/sql-types.rkt +++ b/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)