suzanne.soy/trivial
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[db] fail tests, things are looking ok

Browse Source
This commit is contained in:
ben 2016-03-09 23:48:03 -05:00
parent 6c98c2f7c5
commit 4b1d10ff18
3 changed files with 161 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
private/db.rkt
View File

@ -3,12 +3,16 @@
;; TODO do not use this library, it's just for demonstration
(provide
(all-from-out db)
start-transaction
rollback-transaction
query-exec
Connection
;(rename-out [quasiquote DB]) ;; TODO try using struct types
let-schema:
define-schema:
let-connection:
define-connection:
postgresql-connect:
@ -41,6 +45,10 @@
(postgresql-connect (->* [#:user String #:database String] [] Connection))
(query-row (-> Connection String Any * (Vectorof Any)))
(query-maybe-row (-> Connection String Any * (Option (Vectorof Any))))
;; ---
(start-transaction (-> Connection Void))
(rollback-transaction (-> Connection Void))
(query-exec (-> Connection String Any * Void))
)
;; =============================================================================

147
test/db-fail.rkt Normal file
View File

@ -0,0 +1,147 @@
#lang racket/base
(require trivial/private/test-common
(only-in typed/racket/base
with-handlers raise lambda : -> Any List String Natural Integer Vector))
;; === HOLY BOILERPLATE BATMAN
(module+ test (test-compile-error
#:require trivial/private/db
#:exn #rx"query-row::|Type Checker"
;; ===========================================================================
;; === TEST reference missing table
(let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
[cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
(let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
(let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
(let ([with-transaction (lambda ([thunk : (-> Any)])
(define maybe-exn
(with-handlers ([exn? (lambda ([e : exn]) e)])
(start-transaction conn)
(thunk)
#f))
(rollback-transaction conn)
(if maybe-exn (raise maybe-exn) (void)))]
[insert-fish (lambda ([x : (List String Natural)])
(query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
[insert-cube (lambda ([x : (List Integer Integer Integer)])
(query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
(query-exec conn fish-sql)
(query-exec conn cube-sql)
(define f1 '("Marlin" 8))
(define c1 '(2 4 8))
(insert-fish f1)
(insert-cube c1)
;; -------------------------------------------------------------------
(query-row: conn "SELECT * FROM fake_table")))))
;; ===========================================================================
;; === TEST missing row
(let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
[cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
(let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
(let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
(let ([with-transaction (lambda ([thunk : (-> Any)])
(define maybe-exn
(with-handlers ([exn? (lambda ([e : exn]) e)])
(start-transaction conn)
(thunk)
#f))
(rollback-transaction conn)
(if maybe-exn (raise maybe-exn) (void)))]
[insert-fish (lambda ([x : (List String Natural)])
(query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
[insert-cube (lambda ([x : (List Integer Integer Integer)])
(query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
(query-exec conn fish-sql)
(query-exec conn cube-sql)
(define f1 '("Marlin" 8))
(define c1 '(2 4 8))
(insert-fish f1)
(insert-cube c1)
;; -------------------------------------------------------------------
(query-row: conn "SELECT * FROM fish where fish.fry = 1")))))
;; ===========================================================================
;; === TEST missing actual parameter
(let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
[cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
(let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
(let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
(let ([with-transaction (lambda ([thunk : (-> Any)])
(define maybe-exn
(with-handlers ([exn? (lambda ([e : exn]) e)])
(start-transaction conn)
(thunk)
#f))
(rollback-transaction conn)
(if maybe-exn (raise maybe-exn) (void)))]
[insert-fish (lambda ([x : (List String Natural)])
(query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
[insert-cube (lambda ([x : (List Integer Integer Integer)])
(query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
(query-exec conn fish-sql)
(query-exec conn cube-sql)
(define f1 '("Marlin" 8))
(define c1 '(2 4 8))
(insert-fish f1)
(insert-cube c1)
;; -------------------------------------------------------------------
(query-row: conn "SELECT * FROM fish where fish.name = $1")))))
;; ===========================================================================
;; === TEST wrong type for actual parameter
(let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
[cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
(let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
(let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
(let ([with-transaction (lambda ([thunk : (-> Any)])
(define maybe-exn
(with-handlers ([exn? (lambda ([e : exn]) e)])
(start-transaction conn)
(thunk)
#f))
(rollback-transaction conn)
(if maybe-exn (raise maybe-exn) (void)))]
[insert-fish (lambda ([x : (List String Natural)])
(query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
[insert-cube (lambda ([x : (List Integer Integer Integer)])
(query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
(query-exec conn fish-sql)
(query-exec conn cube-sql)
(define f1 '("Marlin" 8))
(define c1 '(2 4 8))
(insert-fish f1)
(insert-cube c1)
;; -------------------------------------------------------------------
(query-row: conn "SELECT * FROM fish where fish.name = $1" 666)))))
;; ===========================================================================
;; === TEST skipping query parameter
(let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
[cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
(let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
(let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
(let ([with-transaction (lambda ([thunk : (-> Any)])
(define maybe-exn
(with-handlers ([exn? (lambda ([e : exn]) e)])
(start-transaction conn)
(thunk)
#f))
(rollback-transaction conn)
(if maybe-exn (raise maybe-exn) (void)))]
[insert-fish (lambda ([x : (List String Natural)])
(query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
[insert-cube (lambda ([x : (List Integer Integer Integer)])
(query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
(query-exec conn fish-sql)
(query-exec conn cube-sql)
(define f1 '("Marlin" 8))
(define c1 '(2 4 8))
(insert-fish f1)
(insert-cube c1)
;; -------------------------------------------------------------------
(query-row: conn "SELECT * FROM fish where fish.name = $3" "Marlin")))))
))

12
test/db-pass.rkt
View File

@ -12,11 +12,6 @@
trivial/vector
trivial/private/db)
(require/typed db
(start-transaction (-> Connection Void))
(rollback-transaction (-> Connection Void))
(query-exec (-> Connection String Any * Void)))
(define-type Id Natural)
;; -- create fake database
@ -111,6 +106,9 @@
(ann (vector-length: v) One)
1))
;(query-row: c "SELECT * FROM word WHERE word.word = $1 word.id = $2" "blossom")
;(query-row: c "SELECT * FROM word WHERE word.word = $1 word.id = $4" "blossom" 2)
(let-vector: ([v (query-row: conn "SELECT id, weight FROM fish WHERE fish.name = 'Dorado'")])
(check-equal? (vector-ref: v 0) 3)
(check-equal? (vector-ref: v 1) (fish-weight f3))
(check-equal? (vector-length: v) 2))
)))