(module io mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1)))
  (require (planet "util.ss" ("schematics" "schemeunit.plt" 1)))
  (require (lib "etc.ss"))
  (require/expose "../../io.ss" (ones-mask))

  (define test:with-output-to-string
    (make-test-suite
     "with-output-to-string"
     (make-test-case "empty string"
                     (assert string=? (with-output-to-string (void)) ""))
     (make-test-case "a few display operations"
                     (assert string=? (with-output-to-string
                                       (display "hello")
                                       (display ", ")
                                       (display "world")
                                       (display "!")
                                       (newline))
                             "hello, world!\n"))))

  (define test:ones-mask
    (make-test-suite
     "ones-mask"
     (make-test-case "zero"
                     (assert = (ones-mask 0) 0))
     (make-test-case "one through ten"
                     (let loop ([i 1])
                       (unless (>= i 10)
                         (let ([ans (ones-mask i)]
                               [expected (build-string (* 8 i) (lambda (x) #\1))])
                           (assert string=? (format "~b" ans) expected)))))))

  (define test:bit-set?
    (make-test-suite
     "bit-set?"
     (make-test-case ""
                     (assert-true (bit-set? 0 #b1)))
     (make-test-case ""
                     (assert-true (bit-set? 1 #b10)))
     (make-test-case ""
                     (assert-true (bit-set? 2 #b100)))
     (make-test-case ""
                     (assert-true (bit-set? 9 #b1000000000)))
     (make-test-case ""
                     (assert-false (bit-set? 0 #b11111111110)))
     (make-test-case ""
                     (assert-false (bit-set? 1 #b11111111101)))
     (make-test-case ""
                     (assert-false (bit-set? 2 #b11111111011)))
     (make-test-case ""
                     (assert-false (bit-set? 9 #b10111111111)))
     ))

  (define test:stretch-bytes
    (make-test-suite
     "stretch-bytes"
     (make-test-case "stretch big-endian"
                     (assert bytes=? (stretch-bytes #"dave" 8 #t (char->integer #\X))
                                     #"XXXXdave"))
     (make-test-case "stretch small-endian"
                     (assert bytes=? (stretch-bytes #"dave" 8 #f (char->integer #\X))
                                     #"daveXXXX"))
     (make-test-case "stretch big-endian with default fill"
                     (assert bytes=? (stretch-bytes #"dave" 8 #t)
                                     #"\0\0\0\0dave"))
     (make-test-case "stretch small-endian with default fill"
                     (assert bytes=? (stretch-bytes #"dave" 8 #f)
                                     #"dave\0\0\0\0"))
     (make-test-case "stretch none big-endian"
                     (assert bytes=? (stretch-bytes #"dave" 4 #t)
                                     #"dave"))
     (make-test-case "stretch none small-endian"
                     (assert bytes=? (stretch-bytes #"dave" 4 #f)
                                     #"dave"))
     ;; TODO: why isn't this an exn:fail:contract?
     (make-test-case "stretch not enough big-endian"
                     (assert-exn exn:fail?
                                 (lambda ()
                                   (stretch-bytes #"dave" 2 #t))))
     (make-test-case "stretch not enough small-endian"
                     (assert-exn exn:fail?
                                 (lambda ()
                                   (stretch-bytes #"dave" 3 #f))))
     ))

  (define (integer->bytes->integer n big-endian?)
    (bytes->integer (integer->integer-bytes n 4 #f big-endian?)
                    #t
                    big-endian?))

  (define test:bytes->integer/unsigned
    (make-test-suite
     "bytes->integer (unsigned)"
     (make-test-case "No bytes - big-endian"
                     (assert = (bytes->integer (bytes) #f #t) 0))
     (make-test-case "No bytes - small-endian"
                     (assert = (bytes->integer (bytes) #f #f) 0))
     (make-test-case "Simple test 1 - big-endian"
                     (assert = (bytes->integer (bytes 2 1) #f #t) 513))
     (make-test-case "Simple test 1 - small-endian"
                     (assert = (bytes->integer (bytes 2 1) #f #f) 258))
     (make-test-case "Reverse endianness"
                     (assert = (bytes->integer (bytes 24 28 200 12) #f #t)
                               (bytes->integer (bytes 12 200 28 24) #f #f)))
     (make-test-case "compatible with integer->integer-bytes"
                     (assert = (integer->bytes->integer 2461357 #t) 2461357))
     ))

  (define test:bytes->integer/signed
    (make-test-suite
     "bytes->integer (signed)"
     (make-test-case "-1 in one byte"
                     (assert = (bytes->integer #"\377" #t #t) -1))
     (make-test-case "-1 in two bytes"
                     (assert = (bytes->integer #"\377\377" #t #t) -1))
     (make-test-case "-1 in four bytes"
                     (assert = (bytes->integer #"\377\377\377\377" #t #t) -1))
     (make-test-case "-20"
                     (assert = (bytes->integer #"\377\354" #t #t) -20))
     (make-test-case "-38274773"
                     (assert = (bytes->integer #"\375\267\371+" #t #t) -38274773))
     (make-test-case "-3333333333333333333"
                     (assert =
                             (bytes->integer #"\321\275\236\376|\262\252\253" #t #t)
                             -3333333333333333333))
     ))

  (define test:integer->bytes/unsigned
    (make-test-suite
     "integer->bytes (unsigned)"
     (make-test-case "1"
                     (assert bytes=? (integer->bytes 1 #f #t 1) #"\001"))
     (make-test-case "255"
                     (assert bytes=? (integer->bytes 255 #f #t 2) #"\000\377"))
     (make-test-case "3527688"
                     (assert bytes=? (integer->bytes 3527688 #f #t 4) #"\0005\324\b"))
     ))

  (define test:integer->bytes/signed
    (make-test-suite
     "integer->bytes (signed)"
     (make-test-case "-1"
                     (assert bytes=? (integer->bytes -1 #t #t 1) #"\377"))
     (make-test-case "-255"
                     (assert bytes=? (integer->bytes -255 #t #t 2) #"\377\1"))
     (make-test-case "-3527688"
                     (assert bytes=? (integer->bytes -3527688 #t #t 4) #"\377\312+\370"))
     ))

  (define io-tests
    (make-test-suite
     "All io.ss tests"
     test:ones-mask
     test:with-output-to-string
     test:bit-set?
     test:stretch-bytes
     test:bytes->integer/unsigned
     test:bytes->integer/signed
     test:integer->bytes/unsigned
     test:integer->bytes/signed
     ))

  (provide io-tests))