256 lines
8.0 KiB
Racket
256 lines
8.0 KiB
Racket
#lang racket/base
|
|
(require racket/match
|
|
racket/cmdline
|
|
racket/file
|
|
rackunit
|
|
rackunit/text-ui
|
|
racket/unit
|
|
db
|
|
"config.rkt"
|
|
(prefix-in db-
|
|
(combine-in "db/connection.rkt"
|
|
"db/query.rkt"
|
|
"db/sql-types.rkt"
|
|
"db/concurrent.rkt"))
|
|
(prefix-in gen-
|
|
(combine-in "gen/misc.rkt"
|
|
"gen/sql-types.rkt"
|
|
"gen/query.rkt")))
|
|
(provide (all-defined-out))
|
|
|
|
#|
|
|
|
|
RUNNING THE TESTS
|
|
-----------------
|
|
|
|
1) Default test configuration.
|
|
|
|
To run the default tests (ie, the generic tests and sqlite3 tests),
|
|
simply execute this file with no arguments:
|
|
|
|
racket -l tests/db/all-tests
|
|
|
|
This is how DrDr runs the file---we assume the machine running DrDr
|
|
has sqlite installed.
|
|
|
|
2) Custom test configuration.
|
|
|
|
First, set up the testing environment as described in the following
|
|
subsections.
|
|
|
|
Then, run the tests with the following command line:
|
|
|
|
racket -l tests/db/all-tests -- -g <label> ...
|
|
|
|
Each <label> is either a <dsn> or a <confname>.
|
|
|
|
== <dsn> ==
|
|
|
|
A <dsn> is turned into a symbol and looked up using 'get-dsn'. The
|
|
db-specific tests (which is most of them) are run using the resulting
|
|
data source. The data source must conform to the following rules:
|
|
|
|
- It must include all necessary connection arguments (including the
|
|
password, if one is required).
|
|
|
|
- It should have an extension property named 'db:test whose value is
|
|
a list. The list should contain exactly one of the following
|
|
symbols, specifying the SQL dialect used by the data source: 'ispg,
|
|
'ismy, 'issl, 'isora, 'isdb2.
|
|
|
|
- If either 'isora or 'isdb2 is set, the database should already be
|
|
populated with the "the_numbers" table (see config.rkt for definition
|
|
and test data). Otherwise, it is automatically created as a temporary
|
|
table for each test case.
|
|
|
|
Running the tests on a new database system will almost certainly
|
|
require changing the test suite to generate the correct SQL dialect
|
|
and to selectively disable tests that can't run on a particular
|
|
system.
|
|
|
|
== <confname>: Defining testing configurations ==
|
|
|
|
The "db-test.rktd" pref file (see definition of 'pref-file' below
|
|
gives a mapping from <confnames> (ie, symbols) to <conf>s, which
|
|
aggregate multiple testing data sources into a single profile.
|
|
|
|
<conf> ::= (profile <conf> ...)
|
|
| (dsn <symbol>)
|
|
| (ref <symbol>)
|
|
|
|
Testing profiles are flattened, not hierarchical.
|
|
|
|
|#
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define pref-file
|
|
(make-parameter (build-path (find-system-path 'pref-dir) "db-test.rktd")))
|
|
|
|
(define (get-dbconf name)
|
|
(let ([conf (get-preference name (lambda () #f) 'timestamp (pref-file))])
|
|
(if conf
|
|
(parse-dbconf conf)
|
|
(let ([r (get-dsn name)])
|
|
(if r
|
|
(list (dbconf name r))
|
|
(error 'get-dbconf "no such dbconf: ~e" name))))))
|
|
|
|
(struct dbconf (name dsn) #:transparent)
|
|
|
|
(define-syntax-rule (expect name pred)
|
|
(unless (pred name) (error 'parse "bad ~a: ~e" 'name name)))
|
|
|
|
;; parse-dbconf : sexpr -> (listof dbconf?)
|
|
(define (parse-dbconf x)
|
|
(match x
|
|
[(list 'profile dbconfs ...)
|
|
(apply append (map parse-dbconf dbconfs))]
|
|
[(list 'ref conf-name)
|
|
(expect conf-name symbol?)
|
|
(get-dbconf conf-name)]
|
|
[(list 'dsn dsn-name)
|
|
(expect dsn-name symbol?)
|
|
(list (dbconf dsn-name (get-dsn dsn-name)))]))
|
|
|
|
;; ----
|
|
|
|
;; Set below by command-line parsing
|
|
(define kill-safe? #f)
|
|
|
|
(define (dbconf->unit x)
|
|
(match x
|
|
[(dbconf dbtestname (and r (data-source connector _args exts)))
|
|
(let* ([connect (lambda () (dsn-connect r))]
|
|
[dbsys (case connector ((odbc-driver) 'odbc) (else connector))]
|
|
[dbflags (cond [(assq 'db:test exts) => cadr]
|
|
[else '()])])
|
|
(unit-from-context database^))]))
|
|
|
|
(define (odbc-unit dbtestname dbflags dbargs)
|
|
(dbconf->unit
|
|
(dbconf dbtestname (data-source 'odbc dbargs `((db:test ,dbflags))))))
|
|
|
|
(define sqlite-unit
|
|
(dbconf->unit
|
|
(dbconf "sqlite3, memory"
|
|
(data-source 'sqlite3
|
|
'(#:database memory)
|
|
'((db:test (issl)))))))
|
|
|
|
(define sqlite/p-unit
|
|
(dbconf->unit
|
|
(dbconf "sqlite3, memory, with #:use-place=#t"
|
|
(data-source 'sqlite3
|
|
'(#:database memory #:use-place #t)
|
|
'((db:test (issl async)))))))
|
|
|
|
;; ----
|
|
|
|
(define-unit db-test@
|
|
(import database^
|
|
(tag connect (prefix connect: test^))
|
|
(tag query (prefix query: test^))
|
|
(tag sql-types (prefix sql-types: test^))
|
|
(tag concurrent (prefix concurrent: test^)))
|
|
(export test^)
|
|
(define test
|
|
(make-test-suite
|
|
(format "~a tests" dbtestname)
|
|
(list connect:test
|
|
query:test
|
|
sql-types:test
|
|
concurrent:test))))
|
|
|
|
(define (specialize-test@ db@)
|
|
(compound-unit
|
|
(import)
|
|
(export DB-TEST)
|
|
(link (((DB : database^)) db@)
|
|
(((CONFIG : config^)) config@ DB)
|
|
(((CONNECT-TEST : test^)) db-connection@ CONFIG DB)
|
|
(((QUERY-TEST : test^)) db-query@ CONFIG DB)
|
|
(((SQL-TYPES-TEST : test^)) db-sql-types@ CONFIG DB)
|
|
(((CONCURRENT-TEST : test^)) db-concurrent@ CONFIG DB)
|
|
(((DB-TEST : test^)) db-test@
|
|
DB
|
|
(tag connect CONNECT-TEST)
|
|
(tag query QUERY-TEST)
|
|
(tag sql-types SQL-TYPES-TEST)
|
|
(tag concurrent CONCURRENT-TEST)))))
|
|
|
|
(define (specialize-test db@)
|
|
(define-values/invoke-unit (specialize-test@ db@) (import) (export test^))
|
|
test)
|
|
|
|
(define (odbc-test dsn [flags null])
|
|
(specialize-test (odbc-unit dsn flags `(#:dsn ,dsn))))
|
|
|
|
(define sqlite-test
|
|
(specialize-test sqlite-unit))
|
|
|
|
(define sqlite/p-test
|
|
(specialize-test sqlite/p-unit))
|
|
|
|
(define generic-test
|
|
(make-test-suite "Generic tests (no db)"
|
|
(list gen-misc:test
|
|
gen-sql-types:test
|
|
gen-query:test)))
|
|
|
|
;; ----
|
|
|
|
(define (make-all-tests label dbconfs)
|
|
(make-test-suite (format "All ~s tests" label)
|
|
(for/list ([dbconf (in-list dbconfs)])
|
|
(specialize-test (dbconf->unit dbconf)))))
|
|
|
|
;; ----
|
|
|
|
(define-syntax-rule (setup-debug db@ c)
|
|
(begin (define-values/invoke-unit db@ (import) (export database^))
|
|
(define-values/invoke-unit config@ (import database^) (export config^))
|
|
(define c (connect-and-setup))))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define gui? #f)
|
|
(define include-generic? #f)
|
|
(define include-sqlite? #f)
|
|
|
|
;; If no labels given, run generic tests. If labels given, run generic
|
|
;; tests only if -g option given.
|
|
|
|
(command-line
|
|
#:once-each
|
|
[("--gui") "Run tests in RackUnit GUI" (set! gui? #t)]
|
|
[("-k" "--killsafe") "Wrap with kill-safe-connection" (set! kill-safe? #t)]
|
|
[("-g" "--generic") "Run generic tests" (set! include-generic? #t)]
|
|
[("-s" "--sqlite3") "Run sqlite3 in-memory db tests" (set! include-sqlite? #t)]
|
|
[("-f" "--config-file") file "Use configuration file" (pref-file file)]
|
|
#:args labels
|
|
(let* ([no-labels?
|
|
(not (or include-generic? include-sqlite? (pair? labels)))]
|
|
[tests
|
|
(for/list ([label labels])
|
|
(cons label
|
|
(make-all-tests label (get-dbconf (string->symbol label)))))]
|
|
[tests
|
|
(cond [(or include-sqlite? no-labels?)
|
|
(list* (cons "sqlite3, memory" sqlite-test)
|
|
(cons "sqlite3, memory, #:use-place=#t" sqlite/p-test)
|
|
tests)]
|
|
[else tests])]
|
|
[tests
|
|
(cond [(or include-generic? no-labels?)
|
|
(cons (cons "generic" generic-test) tests)]
|
|
[else tests])])
|
|
(cond [gui?
|
|
(let* ([test/gui (dynamic-require 'rackunit/gui 'test/gui)])
|
|
(apply test/gui #:wait? #t (map cdr tests)))]
|
|
[else
|
|
(for ([test tests])
|
|
(printf "Running ~s tests\n" (car test))
|
|
(time (run-tests (cdr test)))
|
|
(newline))])))
|