;;; Copyright (C) 2020 Wolfgang Corcoran-Mathe
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a
;;; copy of this software and associated documentation files (the
;;; "Software"), to deal in the Software without restriction, including
;;; without limitation the rights to use, copy, modify, merge, publish,
;;; distribute, sublicense, and/or sell copies of the Software, and to
;;; permit persons to whom the Software is furnished to do so, subject to
;;; the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included
;;; in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

;;; Many tests are gratefully borrowed from or inspired by those from
;;; Will Clinger's SRFI 130 test suite.

(cond-expand
  ((library (srfi 158))
   (import (only (srfi 158) generator->list)))
  (else
   (begin
    (define (generator->list gen)
      (let rec ((x (gen)))
        (if (eof-object? x)
            '()
            (cons x (rec (gen)))))))))

;;;; SRFI 78 / test compatibility layer.

(define-syntax check
  (syntax-rules (=>)
    ((check expr => res) (test res expr))))

;;;; Utility

(define-syntax constantly
  (syntax-rules ()
    ((_ obj) (lambda _ obj))))

(define always (constantly #t))
(define never (constantly #f))

;; Returns a list of the values produced by expr.
(define-syntax values~>list
  (syntax-rules ()
    ((_ expr)
     (call-with-values (lambda () expr) list))))

;; If expr causes an exception to be raised, return 'bytestring-error
;; if the raised object satisfies bytestring-error?, and #f otherwise.
(define-syntax catch-bytestring-error
  (syntax-rules ()
   ((_ expr)
    (guard (condition ((bytestring-error? condition) 'bytestring-error)
                      (else #f))
      expr))))

;; Testing shorthand for write-binary-bytestring.
(define (%bytestring/IO . args)
  (call-with-port (open-output-bytevector)
                  (lambda (port)
                    (apply write-binary-bytestring port args)
                    (get-output-bytevector port))))

;; Testing shorthands for SNB I/O.  Coverage library fans, eat your
;; hearts out.
(define (parse-SNB/prefix s)
  (call-with-port (open-input-string s)
                  (lambda (p)
                    (read-textual-bytestring #t p))))

(define (parse-SNB s)
  (call-with-port (open-input-string s)
                  (lambda (p)
                    (read-textual-bytestring #f p))))

(define (%bytestring->SNB bstring)
  (call-with-port (open-output-string)
                  (lambda (port)
                    (write-textual-bytestring bstring port)
                    (get-output-string port))))


(define test-bstring #u8"lorem")

(define homer
  #u8"The Man, O Muse, informe, who many a way / \
      Wound in his wisedome to his wished stay;")

(define homer64
  "VGhlIE1hbiwgTyBNdXNlLCBpbmZvcm1lLCB3aG8gbWFueSBhIHdheSAvIFdvd\
   W5kIGluIGhpcyB3aXNlZG9tZSB0byBoaXMgd2lzaGVkIHN0YXk7")

(define homer64-w
  "VGhlIE1hb iwgTyBNdXNlL CBpbmZvcm1lL\nCB3aG8gbWF\tueSBhIH\rdheSAvIFdvd\
   W5kIGluI   GhpcyB    3aXNlZ\t\t\nG9tZSB0b    yBoaXMgd\t2lzaGVkIHN0YXk7")

(define random-bstrings
  '(#u8(124 199 173 212 209 232 249 16 198 32 123 111 130 92 64 155)
    #u8(50 133 193 27 177 105 10 186 61 149 177 105 96 70 223 190)
    #u8(0 117 226 155 110 0 66 216 27 129 187 81 17 210 71 152)
    #u8(123 31 159 25 100 135 246 47 249 137 243 241 45 241 240 221)
    #u8(207 186 70 110 118 231 79 195 153 253 93 101 126 198 70 235)
    #u8(138 176 92 152 208 107 28 236 198 254 111 37 241 116 191 206)
    #u8(221 254 214 90 0 155 132 92 157 246 199 224 224 142 91 114)
    #u8(228 216 233 80 142 15 158 54 5 85 174 101 111 75 126 209)
    #u8(191 16 83 245 45 98 72 212 148 202 135 19 213 150 141 121)
    #u8(41 169 182 96 47 184 16 116 196 251 243 93 81 162 175 140)
    #u8(85 49 218 138 132 11 27 11 182 27 120 71 254 169 132 166)
    #u8(89 216 175 23 97 10 237 112 208 195 112 80 198 154 241 254)
    #u8(187 54 6 57 250 137 129 89 188 19 225 217 168 178 174 129)
    #u8(88 164 89 40 175 194 108 56 12 124 109 96 148 149 119 109)
    #u8(241 66 32 115 203 71 128 154 240 111 194 137 73 44 146 3)
    #u8(177 185 177 233 18 14 178 106 110 109 222 147 111 157 216 208)))

(test-group "Constructor"
  (check (bytestring "lo" #\r #x65 #u8(#x6d)) => test-bstring)
  (check (bytestring)                         => (bytevector))

  (check (catch-bytestring-error (bytestring #x100)) => 'bytestring-error)
  (check (catch-bytestring-error (bytestring "λ"))   => 'bytestring-error))

(test-group "Conversions"
  (check (bytevector->hex-string test-bstring) => "6c6f72656d")
  (check (hex-string->bytevector "6c6f72656d") => test-bstring)
  (check (catch-bytestring-error
          (hex-string->bytevector "c6f72656d"))
   => 'bytestring-error)
  (check (catch-bytestring-error
          (hex-string->bytevector "6czf72656d"))
   => 'bytestring-error)
  (check (equal? (hex-string->bytevector (bytevector->hex-string homer))
                 homer)
   => #t)

  (check (hex-string->bytevector (bytevector->hex-string #u8())) => #u8())

  (check (bytevector->base64 test-bstring)             => "bG9yZW0=")
  (check (bytevector->base64 #u8(#xff #xef #xff))      => "/+//")
  (check (bytevector->base64 #u8(#xff #xef #xff) "*@") => "@*@@")
  (check (equal? (bytevector->base64 homer) homer64)   => #t)
  (check (bytevector->base64 #u8(1))                   => "AQ==")
  (check (bytevector->base64 #u8())                    => "")
  (check (base64->bytevector "bG9yZW0=")               => test-bstring)
  (check (base64->bytevector "/+//")                   => #u8(#xff #xef #xff))
  (check (base64->bytevector "@*@@" "*@")              => #u8(#xff #xef #xff))
  (check (equal? (base64->bytevector homer64) homer)   => #t)
  (check (equal? (base64->bytevector homer64-w) homer) => #t)
  (check (base64->bytevector "AQ==")                   => #u8(1))
  (check (base64->bytevector "")                       => #u8())
  (check (base64->bytevector "\n\n\n==\t\r\n")         => #u8())
  (check (catch-bytestring-error
          (base64->bytevector "bG9@frob"))             => 'bytestring-error)

  (check (bytestring->list #u8()) => '())
  (check (bytestring->list (bytestring 70 82 0 66)) => '(#\F #\R 0 #\B))
  (check (bytestring->list (bytestring "\a\t\t\n" 200)) => '(7 9 9 10 200))
  (check (make-bytestring (bytestring->list test-bstring)) => test-bstring)
  (check (make-bytestring (bytestring->list test-bstring 2)) => #u8"rem")
  (check (make-bytestring (bytestring->list test-bstring 1 3)) => #u8"or")

  (let ((bvec (make-bytevector 5)))
    (check (begin
            (make-bytestring! bvec 0 '(#x6c #x6f #x72 #x65 #x6d))
            bvec)
     => test-bstring))
  (let ((bvec (make-bytevector 9 #x20)))
    (check (begin (make-bytestring! bvec 2 '("lo" #\r #x65 #u8(#x6d)))
                  bvec)
     => #u8"  lorem  "))
  (check (catch-bytestring-error (make-bytestring '("λ")))
   => 'bytestring-error)
  (check (catch-bytestring-error (make-bytestring '(#x100)))
   => 'bytestring-error)

  (let ((s (list-tabulate (bytevector-length test-bstring)
                          (lambda (i)
                            (bytevector-u8-ref test-bstring i)))))
    (check (let ((g (make-bytestring-generator "lo" #\r #x65 #u8(#x6d))))
             (generator->list g))
     => s))
  (check (catch-bytestring-error (make-bytestring-generator "λ" #\m #\u))
   => 'bytestring-error)
  (check (catch-bytestring-error (make-bytestring-generator 89 90 300))
   => 'bytestring-error)
)

(test-group "Selection"
  (check (bytestring-pad test-bstring (bytevector-length test-bstring) #x7a)
   => test-bstring)
  (check (utf8->string (bytestring-pad test-bstring 8 #x7a))
   => "zzzlorem")
  (check (equal? (bytestring-pad test-bstring 8 #\z)
                 (bytestring-pad test-bstring 8 (char->integer #\z)))
   => #t)
  (check (bytestring-pad-right test-bstring
                               (bytevector-length test-bstring)
                               #x7a)
   => test-bstring)
  (check (utf8->string (bytestring-pad-right test-bstring 8 #x7a))
   => "loremzzz")
  (check (equal? (bytestring-pad-right test-bstring 8 #\z)
                 (bytestring-pad-right test-bstring 8 (char->integer #\z)))
   => #t)

  (check (bytestring-trim test-bstring always) => #u8())
  (check (bytestring-trim test-bstring never)  => test-bstring)
  (check (bytestring-trim test-bstring (lambda (u8) (< u8 #x70)))
   => #u8(#x72 #x65 #x6d))
  (check (bytestring-trim-right test-bstring always) => #u8())
  (check (bytestring-trim-right test-bstring never)  => test-bstring)
  (check (bytestring-trim-right test-bstring (lambda (u8) (< u8 #x70)))
   => #u8(#x6c #x6f #x72))
  (check (bytestring-trim-both test-bstring always) => #u8())
  (check (bytestring-trim-both test-bstring never)  => test-bstring)
  (check (bytestring-trim-both test-bstring (lambda (u8) (< u8 #x70)))
   => #u8(#x72)))

(test-group "Replacement"
  (check (bytestring-replace test-bstring #u8"mists" 1 5 1 5)
   => #u8"lists")
  (check (bytestring-replace test-bstring #u8"faded" 2 5 1 5)
   => #u8"loaded")
  (check (bytestring-replace (make-bytevector 5)
                             test-bstring
                             0
                             (bytevector-length test-bstring))
   => test-bstring)

  (let ((bv1 #u8"food") (bv2 #u8"od fo"))
    (check (bytestring-replace bv1 bv2 2 2 0 5) => #u8"food food"))
  (let ((bv1 #u8"food food"))
    (check (bytestring-replace bv1 (bytevector) 2 7 0 0) => #u8"food"))
)

(test-group "Comparison"
  (check (bytestring<? #u8() #u8()) => #f)
  (check (bytestring<? #u8() #u8(1 2 3)) => #t)
  (check (bytestring<? #u8(1 2 3) #u8()) => #f)
  (check (bytestring<? #u8(1 2 3) #u8(1 2 3)) => #f)
  (check (bytestring<? #u8(1 2 3) #u8(1 2 3 4)) => #t)
  (check (bytestring<? #u8(1 2 3 4) #u8(1 2 3)) => #f)
  (check (bytestring<? #u8"abc" #u8"ABC") => #f)
  (check (bytestring<? #u8"ABC" #u8"abc") => #t)
  (check (bytestring<? #u8"abc" #u8"ABCD") => #f)
  (check (bytestring<? #u8"abcd" #u8"ABC") => #f)
  (check (bytestring<? #u8"abcd" #u8"ABCE") => #f)
  (check (bytestring<? #u8"ABCD" #u8"bce") => #t)
  (check (bytestring<? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xff)) => #f)
  (check (bytestring<? #u8(#xfd #xfe) #u8(#xfd #xfe #xff)) => #t)
  (check (bytestring<? #u8(#xfd #xfe #xfc) #u8(#xfd #xfe #xff)) => #t)
  (check (bytestring<? #u8(#xfd #xfe #xff) #u8(#xfd #xfe)) => #f)
  (check (bytestring<? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xfc)) => #f)
  (check (bytestring<? #u8"abc" #u8"abc" #u8"abc") => #f)
  (check (bytestring<? #u8"a" #u8"ab" #u8"abc") => #t)
  (check (bytestring<? #u8"A" #u8"ab" #u8"aBC") => #f)
  (check (bytestring<? #u8"A" #u8"ab" #u8"aB") => #f)
  (check (bytestring<? #u8"Abc" #u8"ab" #u8"a") => #f)
  (check (bytestring<? #u8"Abc" #u8"ab" #u8"aB") => #f)
  (check (bytestring<? #u8"A" #u8"abC" #u8"aB") => #f)
  (check (bytestring<? #u8"A" #u8"aBc" #u8"ab") => #t)

  (check (bytestring<=? #u8() #u8()) => #t)
  (check (bytestring<=? #u8() #u8(1 2 3)) => #t)
  (check (bytestring<=? #u8(1 2 3) #u8()) => #f)
  (check (bytestring<=? #u8(1 2 3) #u8(1 2 3)) => #t)
  (check (bytestring<=? #u8(1 2 3) #u8(1 2 3 4)) => #t)
  (check (bytestring<=? #u8(1 2 3 4) #u8(1 2 3)) => #f)
  (check (bytestring<=? #u8"abc" #u8"ABC") => #f)
  (check (bytestring<=? #u8"ABC" #u8"abc") => #t)
  (check (bytestring<=? #u8"abc" #u8"ABCD") => #f)
  (check (bytestring<=? #u8"abcd" #u8"ABC") => #f)
  (check (bytestring<=? #u8"abcd" #u8"ABCE") => #f)
  (check (bytestring<=? #u8"ABCD" #u8"bce") => #t)
  (check (bytestring<=? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xff)) => #t)
  (check (bytestring<=? #u8(#xfd #xfe) #u8(#xfd #xfe #xff)) => #t)
  (check (bytestring<=? #u8(#xfd #xfe #xfc) #u8(#xfd #xfe #xff)) => #t)
  (check (bytestring<=? #u8(#xfd #xfe #xff) #u8(#xfd #xfe)) => #f)
  (check (bytestring<=? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xfc)) => #f)
  (check (bytestring<=? #u8"abc" #u8"abc" #u8"abc") => #t)
  (check (bytestring<=? #u8"a" #u8"ab" #u8"abc") => #t)
  (check (bytestring<=? #u8"A" #u8"ab" #u8"aBC") => #f)
  (check (bytestring<=? #u8"A" #u8"ab" #u8"aB") => #f)
  (check (bytestring<=? #u8"Abc" #u8"aB" #u8"a") => #f)
  (check (bytestring<=? #u8"Abc" #u8"ab" #u8"aB") => #f)
  (check (bytestring<=? #u8"A" #u8"abC" #u8"aB") => #f)
  (check (bytestring<=? #u8"A" #u8"aBc" #u8"ab") => #t)

  (check (bytestring>? #u8() #u8()) => #f)
  (check (bytestring>? #u8() #u8(1 2 3)) => #f)
  (check (bytestring>? #u8(1 2 3) #u8()) => #t)
  (check (bytestring>? #u8(1 2 3) #u8(1 2 3)) => #f)
  (check (bytestring>? #u8(1 2 3) #u8(1 2 3 4)) => #f)
  (check (bytestring>? #u8(1 2 3 4) #u8(1 2 3)) => #t)
  (check (bytestring>? #u8"abc" #u8"ABC") => #t)
  (check (bytestring>? #u8"ABC" #u8"abc") => #f)
  (check (bytestring>? #u8"abc" #u8"ABCD") => #t)
  (check (bytestring>? #u8"abcd" #u8"ABC") => #t)
  (check (bytestring>? #u8"abcd" #u8"ABCE") => #t)
  (check (bytestring>? #u8"ABCD" #u8"bce") => #f)
  (check (bytestring>? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xff)) => #f)
  (check (bytestring>? #u8(#xfd #xfe) #u8(#xfd #xfe #xff)) => #f)
  (check (bytestring>? #u8(#xfd #xfe #xfc) #u8(#xfd #xfe #xff)) => #f)
  (check (bytestring>? #u8(#xfd #xfe #xff) #u8(#xfd #xfe)) => #t)
  (check (bytestring>? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xfc)) => #t)
  (check (bytestring>? #u8"abc" #u8"abc" #u8"abc") => #f)
  (check (bytestring>? #u8"a" #u8"ab" #u8"abc") => #f)
  (check (bytestring>? #u8"A" #u8"ab" #u8"aBC") => #f)
  (check (bytestring>? #u8"A" #u8"ab" #u8"aB") => #f)
  (check (bytestring>? #u8"Abc" #u8"aB" #u8"a") => #f)
  (check (bytestring>? #u8"abC" #u8"aB" #u8"A") => #t)
  (check (bytestring>? #u8"Abc" #u8"ab" #u8"aB") => #f)
  (check (bytestring>? #u8"A" #u8"abC" #u8"aB") => #f)
  (check (bytestring>? #u8"A" #u8"aBc" #u8"ab") => #f)

  (check (bytestring>=? #u8() #u8()) => #t)
  (check (bytestring>=? #u8() #u8(1 2 3)) => #f)
  (check (bytestring>=? #u8(1 2 3) #u8()) => #t)
  (check (bytestring>=? #u8(1 2 3) #u8(1 2 3)) => #t)
  (check (bytestring>=? #u8(1 2 3) #u8(1 2 3 4)) => #f)
  (check (bytestring>=? #u8(1 2 3 4) #u8(1 2 3)) => #t)
  (check (bytestring>=? #u8"abc" #u8"ABC") => #t)
  (check (bytestring>=? #u8"ABC" #u8"abc") => #f)
  (check (bytestring>=? #u8"abc" #u8"ABCD") => #t)
  (check (bytestring>=? #u8"abcd" #u8"ABC") => #t)
  (check (bytestring>=? #u8"abcd" #u8"ABCE") => #t)
  (check (bytestring>=? #u8"ABCD" #u8"bce") => #f)
  (check (bytestring>=? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xff)) => #t)
  (check (bytestring>=? #u8(#xfd #xfe) #u8(#xfd #xfe #xff)) => #f)
  (check (bytestring>=? #u8(#xfd #xfe #xfc) #u8(#xfd #xfe #xff)) => #f)
  (check (bytestring>=? #u8(#xfd #xfe #xff) #u8(#xfd #xfe)) => #t)
  (check (bytestring>=? #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xfc)) => #t)
  (check (bytestring>=? #u8"abc" #u8"abc" #u8"abc") => #t)
  (check (bytestring>=? #u8"a" #u8"ab" #u8"abc") => #f)
  (check (bytestring>=? #u8"A" #u8"ab" #u8"aBC") => #f)
  (check (bytestring>=? #u8"A" #u8"ab" #u8"aB") => #f)
  (check (bytestring>=? #u8"Abc" #u8"aB" #u8"a") => #f)
  (check (bytestring>=? #u8"abC" #u8"aB" #u8"A") => #t)
  (check (bytestring>=? #u8"Abc" #u8"ab" #u8"aB") => #f)
  (check (bytestring>=? #u8"A" #u8"abC" #u8"aB") => #f)
)

(test-group "Searching"
  (define (eq-r? b) (= b #x72))
  (define (lt-r? b) (< b #x72))

  (check (bytestring-index test-bstring always)     => 0)
  (check (bytestring-index test-bstring never)      => #f)
  (check (bytestring-index test-bstring always 3)   => 3)
  (check (bytestring-index test-bstring eq-r?) => 2)

  (check (bytestring-index-right test-bstring always)     => 4)
  (check (bytestring-index-right test-bstring never)      => #f)
  (check (bytestring-index-right test-bstring always 3)   => 4)
  (check (bytestring-index-right test-bstring eq-r?) => 2)

  (check (values~>list (bytestring-span test-bstring always))
   => (list test-bstring (bytevector)))
  (check (values~>list (bytestring-span test-bstring never))
   => (list (bytevector) test-bstring))
  (check (values~>list (bytestring-span test-bstring lt-r?))
   => (list #u8"lo" #u8"rem"))

  (check (values~>list (bytestring-break test-bstring always))
   => (list (bytevector) test-bstring))
  (check (values~>list (bytestring-break test-bstring never))
   => (list test-bstring (bytevector)))
  (check (values~>list (bytestring-break test-bstring eq-r?))
   => (list #u8"lo" #u8"rem")))

(test-group "Join and split"
  (define test-segments '(#u8(1) #u8(2) #u8(3)))

  (check (bytestring-join test-segments #u8(0))         => #u8(1 0 2 0 3))
  (check (bytestring-join test-segments #u8(0) 'prefix) => #u8(0 1 0 2 0 3))
  (check (bytestring-join test-segments #u8(0) 'suffix) => #u8(1 0 2 0 3 0))
  (check (bytestring-join '() #u8(0))                   => #u8())
  (check (bytestring-join test-segments #\space)        => #u8(1 32 2 32 3))
  (check (bytestring-join test-segments 0)              => #u8(1 0 2 0 3))
  (check (bytestring-join test-segments "AB")
   => #u8(1 65 66 2 65 66 3))
  (check (bytestring-join test-segments #u8(7 8))       => #u8(1 7 8 2 7 8 3))
  (check (catch-bytestring-error
          (bytestring-join test-segments 300))          => 'bytestring-error)
  (check (catch-bytestring-error
          (bytestring-join test-segments "λ"))          => 'bytestring-error)
  (check (catch-bytestring-error
           (bytestring-join '() #u8(0) 'strict-infix))  => 'bytestring-error)
  (check (catch-bytestring-error
           (bytestring-join '() #u8(0) 'foofix))        => 'bytestring-error)

  (check (bytestring-split #u8(1 0 2 0 3) 0 'infix)    => test-segments)
  (check (bytestring-split #u8(0 1 0 2 0 3) 0 'prefix) => test-segments)
  (check (bytestring-split #u8(1 0 2 0 3 0) 0 'suffix) => test-segments)
  (check (bytestring-split #u8(0 0) 0)                 => '(#u8() #u8() #u8()))
  (check (bytestring-split #u8() 0)                    => '())
  (check (catch-bytestring-error
           (bytestring-split #u8() 0 'foofix))         => 'bytestring-error))

(test-group "I/O"
  (check (%bytestring/IO "lo" #\r #x65 #u8(#x6d)) => test-bstring)
  (check (%bytestring/IO) => #u8())
  (check (catch-bytestring-error (%bytestring/IO #x100)) => 'bytestring-error)
  (check (catch-bytestring-error (%bytestring/IO "λ")) => 'bytestring-error)

  ;;; read-textual-bytestring

  (check (parse-SNB/prefix "#u8\"\"") => #u8())
  (check (parse-SNB/prefix "#u8\"lorem\"") => test-bstring)
  (check (parse-SNB/prefix "#u8\"\\xde;\\xad;\\xf0;\\x0d;\"")
   => (bytevector #xde #xad #xf0 #x0d))
  (check (parse-SNB/prefix "#u8\"\\\"\\\\\\a\\b\\t\\n\\r\\\|\"")
   => (bytestring #\" #\\ #\alarm #\backspace #\tab #\newline #\return #\|))
  (check (parse-SNB/prefix "#u8\"lor\\\n\te\\   \r\n\tm\"")
   => test-bstring)
  (check (parse-SNB "\"lorem\"") => test-bstring)

  ;; Invalid SNB detection.
  (check (catch-bytestring-error (parse-SNB/prefix "#u\"lorem\""))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8lorem\""))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8\"lorem"))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8\"lorem"))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8\"l\\orem\""))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8\"l\\    orem\""))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8\"l\\x6frem\""))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8\"l\\x6z;rem\""))
   => 'bytestring-error)
  (check (catch-bytestring-error (parse-SNB/prefix "#u8\"α equivalence\""))
   => 'bytestring-error)

  ;;; write-textual-bytestring

  (check (%bytestring->SNB #u8()) => "#u8\"\"")
  (check (%bytestring->SNB test-bstring) => "#u8\"lorem\"")
  (check (%bytestring->SNB (bytevector #xde #xad #xbe #xef))
   => "#u8\"\\xde;\\xad;\\xbe;\\xef;\"")
  (check (%bytestring->SNB
          (bytestring #\" #\\ #\alarm #\backspace #\tab #\newline #\return #\|))
   => "#u8\"\\\"\\\\\\a\\b\\t\\n\\r\\\|\"")

  (check
   (every (lambda (bvec)
            (equal? bvec (parse-SNB/prefix (%bytestring->SNB bvec))))
          random-bstrings)
   => #t)
)

(test-group "CHICKEN extensions"
  (test-group "bytestring-translate"
    (check (bytestring-translate #u8"soccer" '() '()) => #u8"soccer")
    (check (let ((bs #u8"soccer"))
             (eqv? bs (bytestring-translate bs '() '())))
     => #f)
    (check (bytestring-translate #u8"soccer" #\c #\b) => #u8"sobber")
    (check (bytestring-translate #u8"soccer" #\b #\c) => #u8"soccer")
    (check (bytestring-translate #u8(1 1 3 7) 1 4) => #u8(4 4 3 7))
    (check (bytestring-translate #u8(2 2 3 7) 1 4) => #u8(2 2 3 7))
    (check (bytestring-translate #u8"abcd" (string->list "abc")
                                           (string->list "bcd"))
     => #u8"bcdd")
    (check (bytestring-translate #u8"wxyz" (string->list "abc")
                                           (string->list "bcd"))
     => #u8"wxyz")
    (check (bytestring-translate #u8"wxyz" #\w #x76) => #u8"vxyz")
    (check (bytestring-translate #u8"wxyz" #x77 #\v) => #u8"vxyz")
    (check (bytestring-translate #u8"wxyz" '(#\w) '(#x76)) => #u8"vxyz")
    (check (bytestring-translate #u8"wxyz" '(#x77) '(#\v)) => #u8"vxyz")
    (check (bytestring-translate #u8"wxyz" '(#x77) '(#\v #\w)) => #u8"vxyz")
    )

  (test-group "bytestring-substitute"
    (check (bytestring-substitute #u8"soccer" '()) => #u8"soccer")
    (check (let ((bs #u8"soccer"))  ; result is a fresh bytestring?
             (eqv? bs (bytestring-substitute bs '())))
     => #f)
    (check (bytestring-substitute #u8"soccer" '((#\c . #\b))) => #u8"sobber")
    (check (bytestring-substitute #u8"soccer" '((#\b . #\c))) => #u8"soccer")
    (check (bytestring-substitute #u8(1 1 3 7) '((1 . 4))) => #u8(4 4 3 7))
    (check (bytestring-substitute #u8(2 2 3 7) '((1 . 4))) => #u8(2 2 3 7))
    (check (bytestring-substitute #u8"abcd" '((#\a . #\b)
                                              (#\b . #\c)
                                              (#\c . #\d)))
     => #u8"bcdd")
    (check (bytestring-substitute #u8"wxyz" '((#\a . #\b)
                                              (#\b . #\c)
                                              (#\c . #\d)))
     => #u8"wxyz")
    (check (bytestring-substitute #u8"wxyz" '((#\w . #x76))) => #u8"vxyz")
    (check (bytestring-substitute #u8"wxyz" '((#x77 . #\v))) => #u8"vxyz")
    )

  (test-group "bytestring-chomp"
    (check (bytestring-chomp #u8"hello\n") => #u8"hello")
    (check (bytestring-chomp #u8"hello") => #u8"hello")
    (check (let ((s #u8"hello"))
             (eqv? s (bytestring-chomp s))) => #f)  ; always newly-allocated
    (check (bytestring-chomp #u8"hello" #u8"lo") => #u8"hel")
    (check (bytestring-chomp #u8(1 2 3 4 5) #u8(3 4 5)) => #u8(1 2))
    (check (bytestring-chomp #u8(1 2 3 4 5) #u8(4 4 5)) => #u8(1 2 3 4 5))
    (check (bytestring-chomp test-bstring test-bstring) => #u8())
    (check (bytestring-chomp #u8(1 2) #u8(0 1 2)) => #u8(1 2))
    (check (bytestring-chomp #u8() #u8()) => #u8())
    )

  (test-group "subbytestring=?"
    (check (subbytestring=? test-bstring test-bstring) => #t)
    (check (subbytestring=? test-bstring test-bstring 0 0 3) => #t)
    (check (subbytestring=? test-bstring test-bstring 1 0) => #f)
    (check (subbytestring=? test-bstring test-bstring 1 0 3) => #f)
    (check (subbytestring=? #u8"lorem" #u8"LOREM") => #f)
    (check (subbytestring=? #u8"lorem" #u8"LOREM" 0 0 3) => #f)
    (check (subbytestring=? #u8"lorem" #u8"hello" 0 3 2) => #t)
    (check (subbytestring=? #u8"LOREM" #u8"hello" 0 3 2) => #f)
    )

  (test-group "compare3"
    (check (bytestring-compare3 #u8() #u8()) => 0)
    (check (bytestring-compare3 #u8() #u8(1 2 3)) => -1)
    (check (bytestring-compare3 #u8(1 2 3) #u8()) => 1)
    (check (bytestring-compare3 #u8(1 2 3) #u8(1 2 3)) => 0)
    (check (bytestring-compare3 #u8(1 2 3) #u8(1 2 3 4)) => -1)
    (check (bytestring-compare3 #u8(1 2 3 4) #u8(1 2 3)) => 1)
    (check (bytestring-compare3 #u8"abc" #u8"ABC") => 1)
    (check (bytestring-compare3 #u8"ABC" #u8"abc") => -1)
    (check (bytestring-compare3 #u8"abc" #u8"ABCD") => 1)
    (check (bytestring-compare3 #u8"abcd" #u8"ABC") => 1)
    (check (bytestring-compare3 #u8"abcd" #u8"ABCE") => 1)
    (check (bytestring-compare3 #u8"ABCD" #u8"bce") => -1)
    (check (bytestring-compare3 #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xff)) => 0)
    (check (bytestring-compare3 #u8(#xfd #xfe) #u8(#xfd #xfe #xff)) => -1)
    (check (bytestring-compare3 #u8(#xfd #xfe #xfc) #u8(#xfd #xfe #xff)) => -1)
    (check (bytestring-compare3 #u8(#xfd #xfe #xff) #u8(#xfd #xfe)) => 1)
    (check (bytestring-compare3 #u8(#xfd #xfe #xff) #u8(#xfd #xfe #xfc)) => 1)
    )
  )

(test-group "Prefixes"
  (check (bytestring-prefix-length #u8() test-bstring) => 0)
  (check (bytestring-prefix-length test-bstring test-bstring) =>
   (bytevector-length test-bstring))
  (check (bytestring-prefix-length #u8(1 2) #u8(1 3 5 7)) => 1)
  (check (bytestring-prefix-length #u8(1 3 4) #u8(1 3 5 7)) => 2)
  (check (bytestring-prefix-length #u8(2 3 4) #u8(1 3 5 7)) => 0)
  (check (bytestring-prefix-length #u8(1 3) #u8(1 3 5 7)) => 2)
  (check (bytestring-prefix-length #u8"lotad" #u8"LOTAD") => 0)
  (check (bytestring-prefix-length #u8"lorem" #u8"lOTAD") => 1)
  (check (bytestring-prefix-length #u8"LOREM" #u8"lotad") => 0)

  (check (bytestring-prefix? #u8() test-bstring) => #t)
  (check (bytestring-prefix? test-bstring test-bstring) => #t)
  (check (bytestring-prefix? #u8(1 2) #u8(1 3 5 7)) => #f)
  (check (bytestring-prefix? #u8(1 3 4) #u8(1 3 5 7)) => #f)
  (check (bytestring-prefix? #u8(2 3 4) #u8(1 3 5 7)) => #f)
  (check (bytestring-prefix? #u8(1 3) #u8(1 3 5 7)) => #t)
  (check (bytestring-prefix? #u8"lotad" #u8"LOTAD") => #f)
  (check (bytestring-prefix? #u8"lo" #u8"LOTAD") => #f)
  (check (bytestring-prefix? #u8"LO" #u8"lotad") => #f)
  (check (bytestring-prefix? #u8"lO" #u8"Lotad") => #f)
  )

(test-group "Suffixes"
  (check (bytestring-suffix-length #u8() test-bstring) => 0)
  (check (bytestring-suffix-length test-bstring test-bstring) =>
   (bytevector-length test-bstring))
  (check (bytestring-suffix-length #u8(6 7) #u8(1 3 5 7)) => 1)
  (check (bytestring-suffix-length #u8(4 5 7) #u8(1 3 5 7)) => 2)
  (check (bytestring-suffix-length #u8(4 5 8) #u8(1 3 5 7)) => 0)
  (check (bytestring-suffix-length #u8(5 7) #u8(1 3 5 7)) => 2)
  (check (bytestring-suffix-length #u8"lotad" #u8"LOTAD") => 0)
  (check (bytestring-suffix-length #u8"lotad" #u8"FARAd") => 1)
  (check (bytestring-suffix-length #u8"lotAd" #u8"FARad") => 1)

  (check (bytestring-suffix? #u8() test-bstring) => #t)
  (check (bytestring-suffix? test-bstring test-bstring) => #t)
  (check (bytestring-suffix? #u8(6 7) #u8(1 3 5 7)) => #f)
  (check (bytestring-suffix? #u8(3 5 8) #u8(1 3 5 7)) => #f)
  (check (bytestring-suffix? #u8(4 5 8) #u8(1 3 5 7)) => #f)
  (check (bytestring-suffix? #u8(5 7) #u8(1 3 5 7)) => #t)
  (check (bytestring-suffix? #u8"lotad" #u8"LOTAD") => #f)
  (check (bytestring-suffix? #u8"ad" #u8"LOTAD") => #f)
  (check (bytestring-suffix? #u8"AD" #u8"lotad") => #f)
  (check (bytestring-suffix? #u8"aD" #u8"lotAd") => #f)
  )

(test-group "Segment"
  (check (bytestring-segment #u8(1 2 3 4) 1) => '(#u8(1) #u8(2) #u8(3) #u8(4)))
  (check (bytestring-segment #u8(1 2 3 4) 2) => '(#u8(1 2) #u8(3 4)))
  (check (bytestring-segment #u8(1 2 3 4) 3) => '(#u8(1 2 3) #u8(4)))
  (check (bytestring-segment #u8(1 2 3 4) 4) => '(#u8(1 2 3 4)))
  (check (bytestring-segment #u8(1 2 3 4) 5) => '(#u8(1 2 3 4)))
  (check (bytestring-segment #u8"lorem" 2) => '(#u8"lo" #u8"re" #u8"m"))
  (check (every
          (lambda (bs)
            (every (lambda (k)
                     (equal? (apply bytevector-append
                                    (bytestring-segment bs k))
                             bs))
                   (iota (bytevector-length bs) 1)))
          random-bstrings)
   => #t)
  )

(test-group "Contains"
  (check (bytestring-contains #u8() #u8()) => 0)
  (check (bytestring-contains test-bstring #u8()) => 0)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(1)) => 0)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(3 3)) => 2)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(2 3 3)) => 1)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(3 3 4)) => 2)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(1 3 3 4)) => #f)

  (check (bytestring-contains #u8() #u8() 0) => 0)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8() 2) => 2)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(3 3) 2) => 2)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(2 3 3) 1) => 1)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(3 4) 2) => 3)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(1 2) 2) => #f)

  (check (bytestring-contains #u8() #u8() 0 0) => 0)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8() 1 4) => 1)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(1) 1 4) => #f)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(3 3) 1 4) => 2)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(2 3) 1 4) => 1)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(3 4) 1 4) => #f)
  (check (bytestring-contains #u8(1 2 3 3 4) #u8(3 3 4) 1 4) => #f)
  )

(test-group "contains-right"
  (check (bytestring-contains-right #u8() #u8()) => 0)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8()) => 5)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(1)) => 0)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(3)) => 3)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(2 3 3)) => 1)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(3 3 4)) => 2)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(1 3 3 4)) => #f)

  (check (bytestring-contains-right #u8() #u8() 0) => 0)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8() 2) => 5)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(1) 2) => #f)
  (check (bytestring-contains-right #u8(1 2 3 3 3 4) #u8(3 3) 2) => 3)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(3 4) 2) => 3)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(1 3 4) 2) => #f)

  (check (bytestring-contains-right #u8() #u8() 0 0) => 0)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8() 1 4) => 4)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(1) 1 4) => #f)
  (check (bytestring-contains-right #u8(1 2 3 3 3 4) #u8(3 3) 1 5) => 3)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(2 3 3) 1 4) => 1)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(3 4) 1 4) => #f)
  (check (bytestring-contains-right #u8(1 2 3 3 4) #u8(2 3 3 4) 1 4) => #f)
  )

(test-group "concatenate-reverse"
  (check (bytestring-concatenate-reverse '()) => #u8())
  (check (bytestring-concatenate-reverse
          '(#u8"" #u8"a" #u8"bcd" #u8"" #u8"ef" #u8"" #u8""))
   => #u8"efbcda")
  (check (bytestring-concatenate-reverse '() #u8"huh?") => #u8"huh?")
  (check (bytestring-concatenate-reverse
          '(#u8"" #u8"a" #u8"bcd" #u8"" #u8"ef" #u8"" #u8"")
          #u8"xy")
   => #u8"efbcdaxy")
  (check (bytestring-concatenate-reverse '() #u8"huh?" 3) => #u8"huh")
  (check (bytestring-concatenate-reverse
          '(#u8"" #u8"a" #u8"bcd" #u8"" #u8"ef" #u8"" #u8"")
          #u8"xy"
          1)
   => #u8"efbcdax")
  )

(test-group "replicate"
  (check (bytestring-replicate #u8"abcdef" -4 10) => #u8"cdefabcdefabcd")
  (check (bytestring-replicate #u8"abcdef" 90 103 1) => #u8"bcdefbcdefbcd")
  (check (bytestring-replicate #u8"abcdef" -13 -3 2 5) => #u8"ecdecdecde")
  (check (bytestring-replicate #u8"abcdef" 5 10 0 1) => #u8"aaaaa")
  (check (bytestring-replicate #u8"abcdef" 0 0 0 0) => #u8"")
  (check (bytestring-replicate #u8"abcdef" 1 7) => #u8"bcdefa")
  (check (bytestring-replicate #u8"abcdef" -5 1) => #u8"bcdefa")
  (check (bytestring-replicate #u8"abcdef" 1 4) => #u8"bcd")
  )

(test-exit)