postgresql8/sql-data-unit-test.ss
#lang scheme/base

(require scheme/unit
         srfi/19
         srfi/26
         (planet schematics/spgsql:2/spgsql)
         "../test-base.ss"
         "../test-data.ss"
         "../test-util.ss"
         "../era/era.ss"
         "sql-data-unit.ss")

(define-values/invoke-unit/infer sql-data@)

(define time-tai1 (string->time-tai "2001-01-01 01:01:01"))
(define time-tai2 (string->time-tai "2002-02-02 02:02:02"))
(define time-tai3 (string->time-tai "9999-12-31 23:59:59"))

(define time-utc1 (string->time-utc "2001-01-01 01:01:01"))
(define time-utc2 (string->time-utc "2002-02-02 02:02:02"))
(define time-utc3 (string->time-utc "9999-12-31 23:59:59"))

(define sql-data-unit-tests
  (test-suite "sql-data-unit.ss"
    
    (test-case "escape-value : guid"
      (let ([t (make-guid-type #t #f entity:person)])
        (check-equal? (escape-value t #f) "NULL")
        (check-equal? (escape-value t (make-guid entity:person 123)) "123")
        (check-exn exn:fail:contract? (cut escape-value t (make-guid entity:course 123)))))
    
    (test-case "escape-value : boolean"
      (let ([t (make-boolean-type #t #f)])
        (check-equal? (escape-value t #f) "false")
        (check-equal? (escape-value t #t) "true")
        (check-exn exn:fail:contract? (cut escape-value t "123"))))
    
    (test-case "escape-value : integer"
      (let ([t (make-integer-type #t #f)])
        (check-equal? (escape-value t #f) "NULL")
        (check-equal? (escape-value t 1) "1")
        (check-equal? (escape-value t 0) "0")
        (check-equal? (escape-value t -1) "-1")
        (check-exn exn:fail:contract? (cut escape-value t "123"))))
    
    (test-case "escape-value : real"
      (let ([t (make-real-type #t #f)])
        (check-equal? (escape-value t #f) "NULL")
        (check-equal? (escape-value t 0.00000000001) "1e-11")
        (check-equal? (escape-value t 0.0) "0.0")
        (check-equal? (escape-value t 123456789) "123456789")
        (check-exn exn:fail:contract? (cut escape-value t "123"))))
    
    (test-case "escape-value : string"
      (let ([t (make-string-type #t #f #f)])
        (check-equal? (escape-value t #f) "NULL")
        (check-equal? (escape-value t "") "''")
        (check-equal? (escape-value t "Dave") "'Dave'")
        (check-equal? (escape-value t "Dave's stuff") "'Dave''s stuff'")
        (check-equal? (escape-value t "Dave's\\stuff") "'Dave''s\\stuff'")
        (check-equal? (escape-value t "Dave's\nstuff") "'Dave''s\nstuff'")
        (check-equal? (escape-value t "Dave's\n\rstuff") "'Dave''s\n\rstuff'")
        (check-exn exn:fail:contract? (cut escape-value t 123))))
    
    (test-case "escape-value : symbol"
      (let ([t (make-symbol-type #t #f #f)])
        (check-equal? (escape-value t #f) "NULL")
        (check-equal? (escape-value t '||) "''")
        (check-equal? (escape-value t 'Dave) "'Dave'")
        (check-equal? (escape-value t '|Dave's stuff|) "'Dave''s stuff'")
        (check-exn exn:fail:contract? (cut escape-value t "123"))))
    
    (test-case "escape-value : time-tai"
      (let ([t (make-time-tai-type #t #f)])
        (check-equal? (escape-value t #f) "NULL")
        (check-equal? (escape-value t (make-time time-tai 0 0)) "'1970-01-01 00:00:00.000000000'")
        (check-equal? (escape-value t (make-time time-tai 1 0)) "'1970-01-01 00:00:00.000000001'")
        (check-equal? (escape-value t (make-time time-tai 1000 0)) "'1970-01-01 00:00:00.000001000'")
        (check-equal? (escape-value t (make-time time-tai 123456789 0)) "'1970-01-01 00:00:00.123456789'")
        (check-equal? (escape-value t (make-time time-tai 123456789 1)) "'1970-01-01 00:00:01.123456789'")
        (check-equal? (escape-value t time-tai1) "'2001-01-01 01:01:01.000000000'")
        (check-equal? (escape-value t time-tai2) "'2002-02-02 02:02:02.000000000'")
        (check-equal? (escape-value t time-tai3) "'9999-12-31 23:59:59.000000000'")
        (check-exn exn:fail:contract? (cut escape-value t "123") "check 9")))
    
    (test-case "escape-value : time-utc"
      (let ([t (make-time-utc-type #t #f)])
        (check-equal? (escape-value t #f) "NULL")
        (check-equal? (escape-value t (make-time time-utc 0 0)) "'1970-01-01 00:00:00.000000000'")
        (check-equal? (escape-value t (make-time time-utc 1 0)) "'1970-01-01 00:00:00.000000001'")
        (check-equal? (escape-value t (make-time time-utc 1000 0)) "'1970-01-01 00:00:00.000001000'")
        (check-equal? (escape-value t (make-time time-utc 123456789 0)) "'1970-01-01 00:00:00.123456789'")
        (check-equal? (escape-value t (make-time time-utc 123456789 1)) "'1970-01-01 00:00:01.123456789'")
        (check-equal? (escape-value t time-utc1) "'2001-01-01 01:01:01.000000000'")
        (check-equal? (escape-value t time-utc2) "'2002-02-02 02:02:02.000000000'")
        (check-equal? (escape-value t time-utc3) "'9999-12-31 23:59:59.000000000'")
        (check-exn exn:fail:contract? (cut escape-value t "123"))))
    
    (test-exn "escape value : unknown type"
      exn:fail:contract?
      (cut escape-value 'foo "hello"))
    
    (test-case "parse-value : boolean"
      (let ([t (make-boolean-type #t #f)])
        (check-equal? (parse-value t sql-null) #f)
        (check-equal? (parse-value t #t) #t)
        (check-equal? (parse-value t #f) #f)))
    
    (test-case "parse-value : integer"
      (let ([t (make-integer-type #t #f)])
        (check-equal? (parse-value t sql-null) #f)
        (check-equal? (parse-value t 1) 1)
        (check-equal? (parse-value t 0) 0)
        (check-equal? (parse-value t -1) -1)))
    
    (test-case "parse-value : real"
      (let ([t (make-real-type #t #f)])
        (check-equal? (parse-value t sql-null) #f)
        (check-equal? (parse-value t 0.00000000001) 0.00000000001)
        (check-equal? (parse-value t 0.0) 0.0)
        (check-equal? (parse-value t 123456789) 123456789)))
    
    (test-case "parse-value : string"
      (let ([t (make-string-type #t #f #f)])
        (check-equal? (parse-value t sql-null) #f)
        (check-equal? (parse-value t "") "")
        (check-equal? (parse-value t "Dave") "Dave")
        (check-equal? (parse-value t "Dave's stuff") "Dave's stuff")))
    
    (test-case "parse-value : symbol"
      (let ([t (make-symbol-type #t #f #f)])
        (check-equal? (parse-value t sql-null) #f)
        (check-equal? (parse-value t "") '||)
        (check-equal? (parse-value t "Dave") 'Dave)
        (check-equal? (parse-value t "Dave's stuff") '|Dave's stuff|)))
    
    (test-case "parse-value : time-tai"
      (let ([t (make-time-tai-type #t #f)])
        (check-exn exn:fail:contract?
          (cut parse-value t ""))
        (check-equal? (parse-value t (make-sql-timestamp 9999 12 31 23 59 59 0 0)) 
                      time-tai3
                      "check 2 failed")
        (check-equal? (parse-value t (make-sql-timestamp 1234 12 23 12 34 56 123456000 0))
                      (date->time-tai (make-date 123456000 56 34 12 23 12 1234 0)))))
    
    (test-case "parse-value : time-utc"
      (let ([t (make-time-utc-type #t #f)])
        (check-exn exn:fail:contract? (cut parse-value t ""))
        (check-equal? (parse-value t (make-sql-timestamp 1234 12 23 12 34 56 123456000 0))
                      (date->time-utc (make-date 123456000 56 34 12 23 12 1234 0)))))
    
    (test-exn "parse-value : unknown type"
      exn:fail:contract?
      (cut parse-value 'foo "hello"))
    
    (test-case "make-parser"
      (let ([parse (make-parser (list (make-boolean-type #t #f)
                                      (make-integer-type #t #f)
                                      (make-string-type #t #f #f)
                                      (make-symbol-type #t #f #f)))])
        (check-equal? (parse (vector #t 1 "1" "1")) (vector #t 1 "1" '|1|))
        (check-equal? (parse (vector sql-null sql-null sql-null sql-null)) (vector #f #f #f #f))))))

; Provide statements -----------------------------

(provide sql-data-unit-tests)