tests/exceptions.ss
;; Copyright 2000-2005 Ryan Culpepper
;; Released under the terms of the modified BSD license (see the file
;; COPYRIGHT for terms).

(module exceptions mzscheme
  (require "../spgsql.ss"
           (rename "../private/connection.ss" connection% connection%)
           "config.ss")
  (require (lib "class.ss")
           (planet "test.ss" ("schematics" "schemeunit.plt" 1)))
  (provide exception-test)

  (define BAD-PORT 5555)
  (define BAD-USER "johndoe")
  (define BAD-DATABASE "invaliddb")
  (define BAD-PASSWORD "snark")

  ;; NOTE:
  ;; These tests are currently very brittle. This should improve once the
  ;; new SQL error code gets implemented.
  
  (define exception-test
    (make-test-suite "Exceptions"
      (make-test-suite "connect"
        (make-test-case "Control"
          (let [(c (connect HOST PORT DATABASE USER PASSWORD))]
            (assert-pred object? c)
            (assert-true (is-a? c connection<%>))))
        (make-test-case "Bad user"
          (assert-exn (pg-error? "Could not connect to server")
                      (lambda () (connect HOST BAD-PORT DATABASE USER PASSWORD))))
        (make-test-case "Bad database"
          (assert-exn (pg-error? "Error after authentication")
                      (lambda () (connect HOST PORT BAD-DATABASE USER PASSWORD))))
        (make-test-case "Bad user"
          (assert-exn 
           (pg-error? "Authentication failed")
           (lambda () (connect HOST PORT DATABASE BAD-USER PASSWORD))))
        (make-test-case "Bad password"
          (assert-exn (pg-error? "")
                      (lambda () (connect HOST PORT DATABASE USER BAD-PASSWORD))))
        (make-test-case "No password"
          (assert-exn (pg-error? "")
                      (lambda () (connect HOST PORT DATABASE USER #f)))))
      (make-test-suite "connection locking"
        (make-test-case "Query while disconnected"
          (let [(cu (make-object connection%))]
            (assert-exn (spgsql-error? exn:spgsql:user 'lock)
                        (lambda () (send cu query "select * from pg_class")))))
        (make-test-case "Connect while ready"
          (call-with-connection
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:user 'lock)
                         (lambda () (send c connect HOST PORT DATABASE USER)))))))
      (make-test-suite "query methods"
        (make-test-case "query - multiple statements"
          (call-with-connection 
           (lambda (c)
             (assert-exn 
              (spgsql-error? exn:spgsql:user 'expected-single-result)
              (lambda () 
                (send c query "select N from the_numbers; select null"))))))
        (make-test-case "query-list - multiple fields"
          (call-with-connection 
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:user 'expected-single-field)
                         (lambda () 
                           (send c query-list "select N, N from the_numbers"))))))
        (make-test-case "query-list - ErrorResult"
          (call-with-connection
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:query)
                         (lambda () 
                           (send c query-list "select * from nothere"))))))
        (make-test-case "query-tuple - multiple rows"
          (call-with-connection
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:user 'expected-single-row)
                         (lambda () 
                           (send c query-tuple 
                                 "select N, description from the_numbers"))))))
        (make-test-case "query-tuple - ErrorResult"
          (call-with-connection 
           (lambda (c)
             (assert-exn 
              (spgsql-error? exn:spgsql:query)
              (lambda () (send c query-tuple "select * from nothere"))))))
        (make-test-case "query-value - multiple fields"
          (call-with-connection
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:user 'expected-single-row)
                         (lambda () 
                           (send c query-value 
                                 "select N, description from the_numbers"))))))
        (make-test-case "query-value - multiple rows"
          (call-with-connection
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:user 'expected-single-row)
                         (lambda ()
                           (send c query-value
                                 "select N from the_numbers"))))))
        (make-test-case "exec - ErrorResult"
          (call-with-connection
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:query)
                         (lambda () (send c exec "select * from nothere"))))))
        (make-test-case "mapfilter - not a recordset"
          (call-with-connection
           (lambda (c)
             (assert-exn 
              (spgsql-error? exn:spgsql:user 'expected-single-recordset)
              (lambda () (send c mapfilter 
                               "insert into the_numbers values (1024, 'a lot')"
                               void void))))))
        (make-test-case "mapfilter - sql not a string"
          (call-with-connection 
           (lambda (c)
             (assert-exn
              (spgsql-error? exn:spgsql:user 'expected-sql-string)
              (lambda () (send c mapfilter void void void))))))
        (make-test-case "mapfilter - non-procedure"
          (call-with-connection
           (lambda (c)
             (assert-exn (spgsql-error? exn:spgsql:user 'expected-procedure)
                         (lambda () (send c mapfilter "select 5" 'fish void)))
             (assert-exn (spgsql-error? exn:spgsql:user 'expected-procedure)
                         (lambda () (send c mapfilter "select 5" void 17)))))))))
  )