;; Copyright 2000-2007 Ryan Culpepper
;; Released under the terms of the modified BSD license (see the file
;; COPYRIGHT for terms).

(module sql-types mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 7))
           (lib "class.ss")
           (lib "etc.ss")
           "config.ss"
           "../private/sql-data.ss")
  (provide sql-types-test)

  (define (sql-parse type b)
    ((hash-table-get external=>datum type (lambda _ values)) b))

  (define (sql-marshal type d)
    ((hash-table-get datum=>external/typename type (lambda _ values)) d))

  (define-syntax check-roundtrip
    (syntax-rules ()
      [(check-roundtrip c type expr)
       (begin
         (let ([value expr])
           (check-equal? value
                         (let ([q (string-append "select $1::" (symbol->string 'type))])
                           ((send c prepare-query-value q) value)))
           (check-equal? value
                         (let ([q (format-sql "select ~a" [type value])])
                           (send c query-value q)))))]))

  (define sql-types-test
    (test-suite "SQL types"
      (test-suite "Parsing"
        (test-case "Parse boolean"
          (check-eq? #t (sql-parse 'boolin "t"))
          (check-eq? #f (sql-parse 'boolin "f"))
          (check-exn exn? (lambda () (sql-parse 'boolin "g"))))
        (test-case "Parse integer"
          (check-equal? 0 (sql-parse 'int4in "0"))
          (check-equal? 17 (sql-parse 'int4in "17"))
          (check-exn exn? (lambda () (sql-parse 'int4in "")))
          (check-exn exn? (lambda () (sql-parse 'int4in "alpha"))))
        (test-case "Parse float"
          (check-equal? 0.0 (sql-parse 'float4in "0.0"))
          (check-equal? 17.123 (sql-parse 'float4in "17.123"))
          (check-exn exn? (lambda () (sql-parse 'float4in "")))
          (check-exn exn? (lambda () (sql-parse 'float4in "alpha")))))
      (test-suite "Roundtrip"
        (test-case "boolean"
          (call-with-connection
           (lambda (c)
             (check-roundtrip c bool #t)
             (check-roundtrip c bool #f))))
        (test-case "bytea"
          (call-with-connection
           (lambda (c)
             (check-roundtrip c bytea #"this is the time to remember")
             (check-roundtrip c bytea #"that's the way it is")
             (check-roundtrip c bytea (list->bytes (build-list 256 values))))))
        (test-case "numbers"
          (call-with-connection
           (lambda (c)
             (check-roundtrip c int 5)
             (check-roundtrip c int -1)
             (check-roundtrip c int #x7FFFFF)
             (check-roundtrip c int #x-800000)
             (check-roundtrip c float 1.0)
             (check-roundtrip c float 1.1)
             (check-roundtrip c float -5.8)
             (check-roundtrip c float +inf.0)
             (check-roundtrip c float -inf.0)
             (check-roundtrip c float +nan.0))))
        (test-case "numeric"
          (call-with-connection
           (lambda (c)
             (check-roundtrip c numeric 12345678901234567890)
             (check-roundtrip c numeric #e1234567890.0987654321)
             (check-roundtrip c numeric +nan.0))))
        (test-case "strings"
          (call-with-connection
           (lambda (c)
             (check-roundtrip c text "this is the time to remember")
             (check-roundtrip c text "that's the way it is")
             (check-roundtrip c text (string #\\))
             (check-roundtrip c text (string #\'))
             (check-roundtrip c text (string #\\ #\'))
             (check-roundtrip c text "λ the ultimate")
             (check-roundtrip c text (list->string
                                      (build-list 800
                                                  (lambda (n)
                                                    (integer->char (add1 n)))))))))
        (test-case "time"
          (call-with-connection
           (lambda (c)
             (check-roundtrip c time
                              (make-sql-time 12 34 56 #f))
             (check-roundtrip c timetz
                              (make-sql-time 12 34 56 3600))
             (check-roundtrip c date
                              (make-sql-date 1980 08 17))
             (check-roundtrip c timestamp
                              (make-sql-timestamp 1980 08 17 12 34 56 0 #f))
             (check-roundtrip c timestamptz
                              (make-sql-timestamp 1980 08 17 12 34 56 0 3600)))))
        )))
  )