#lang scheme

(require (prefix-in general: "general.ss"))

(require "engine.ss")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; to generate: (integer-bytes->integer (integer->integer-bytes #xdeadbeefdeadbeef 8 #f #t) 8 #t) -> -2401053088876216593
; SELECT encode(int8send(-2401053088876216593::int8),'hex') -> deadbeefdeadbeef
; then just type \x every two...

(define (unsigned->signed integer size)
  (if (integer? integer)
      (integer-bytes->integer (integer->integer-bytes integer size #f #t) #t #t)
      integer))

(define casts
  (map 
   (λ (line)
     (apply (λ (name oid value bytes)
              (list* name (list oid (unsigned->signed value (bytes-length bytes))) (list oid bytes))) line))
   '(("int8" 20 #xde057e0d1a57a515 #"\xde\x05\x7e\x0d\x1a\x57\xa5\x15")
     ("int4" 23 #xbada55ed #"\xba\xda\x55\xed")
     ("int2" 21 #xbee5  #"\xbe\xe5")
     ("boolean" 16 #t #"\x01")
     ("character" 18 #\Q #"\x51")
     ("name" 19 synx #"\x73\x79\x6e\x78")
     )))

(general:set-info! (get-engine))

(require "codec-check.ss")

(define tests 
  (let ([engine (get-engine)])
    (test-codec "general" casts 
                (λ (pair) 
                  (let ([oid (car pair)] [value (cadr pair)])
                    (check-equal? (send engine divine value) oid)
                    (list oid (send engine encode oid value))))
                (λ (pair) 
                  (let ([oid (car pair)] [bytes (cadr pair)])
                    (list oid (send engine decode oid bytes)))))))
(provide tests)