test-bytea.ss
#lang scheme

(require (planet schematics/schemeunit))

(require "main.ss")

(define test-values
  `((1 . #"\x00")
    (2 . #"ferret")
    (3 . ,(string->bytes/utf-8 "pokémon"))
    (4 . #"\xFF\xFF\xFF\xFF")))

(define/provide-test-suite
  tests
   "wrapper"
   (let ([c (connect #:dbname "test" #:user "www" #:port 5433)])
     (send c initialize)
     ;   (with-tracing-to
     ;    ((get-field handle c) "test.log")
     ; (pretty-print (get-field oid-names c))
     ; (pretty-print (escape-identifier (get-field handle c) "foobar"))
     ; (pretty-print (escape-identifier (get-field handle c) "\xcc\xaf\xf3\xff"))
     (test-case
      "create table"
      (send c exec "DROP TABLE IF EXISTS test_bytea")
      (send c exec "CREATE TABLE test_bytea (id INTEGER, data BYTEA)"))
     (test-case
      "inserts"
      (with-transaction 
       c
       (let ([prepared (send c prepare "INSERT INTO test_bytea (id,data) VALUES ($1,$2)")])
         (dict-for-each
          test-values
          (λ (id data)
            (send prepared exec id data))))))
     (test-case
      "selects"
      (dict-for-each
       test-values
       (λ (test-id test-data)
         (send (send c p-exec "SELECT id,data FROM test_bytea WHERE id=$1" test-id) for-each
               (λ (id data)
                 (collect-garbage) ; this would destroy the result returned from p-exec (since we're in tail position)
                 ; but instead the value 'data' is protecting the result!
                 (check-equal? id test-id)
                 (check-equal? data test-data))))))))