From 4b1d10ff18f3ed4bcab7438d0a8184cfe65468fa Mon Sep 17 00:00:00 2001 From: ben Date: Wed, 9 Mar 2016 23:48:03 -0500 Subject: [PATCH] [db] fail tests, things are looking ok --- private/db.rkt | 10 +++- test/db-fail.rkt | 147 +++++++++++++++++++++++++++++++++++++++++++++++ test/db-pass.rkt | 12 ++-- 3 files changed, 161 insertions(+), 8 deletions(-) create mode 100644 test/db-fail.rkt diff --git a/private/db.rkt b/private/db.rkt index 358261b..8575142 100644 --- a/private/db.rkt +++ b/private/db.rkt @@ -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)) ) ;; ============================================================================= diff --git a/test/db-fail.rkt b/test/db-fail.rkt new file mode 100644 index 0000000..f55e85b --- /dev/null +++ b/test/db-fail.rkt @@ -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"))))) + +)) diff --git a/test/db-pass.rkt b/test/db-pass.rkt index 00eb5e4..8252a0d 100644 --- a/test/db-pass.rkt +++ b/test/db-pass.rkt @@ -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)) + )))