Disarchive/tests/kinds/binary-string.scm

;;; Disarchive
;;; Copyright © 2020, 2021 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Disarchive.
;;;
;;; Disarchive is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Disarchive is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Disarchive.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (disarchive kinds binary-string)
             (disarchive serialization)
             (quickcheck)
             (quickcheck arbitrary)
             (quickcheck generator)
             (quickcheck property)
             (rnrs bytevectors)
             (srfi srfi-64)
             (tests kinds))

(configure-quickcheck
 ;; Perform 1000 tests per property...
 (stop? (lambda (success-count _)
          (>= success-count 1000)))
 ;; ...over input sizes from 0 to 10.
 (size (lambda (test-number)
         (if (zero? test-number)
             0
             (1+ (quotient test-number 100))))))

(define (round-trip bv)
  (encode-binary-string (decode-binary-string bv)))

(test-begin "kinds--binary-string")

(test-equal "Preserves invalid leading byte (10...)"
  #vu8(#b10000000)
  (round-trip #vu8(#b10000000)))

(test-equal "Preserves invalid leading byte (111110...)"
  #vu8(#b11111000)
  (round-trip #vu8(#b11111000)))

(test-equal "Preserves missing continuation byte"
  #vu8(#b11000000)
  (round-trip #vu8(#b11000000)))

(test-equal "Preserves invalid continuation byte"
  #vu8(#b11000000 #b00000000)
  (round-trip #vu8(#b11000000 #b00000000)))

(test-assert "[prop] Reading is reversible"
  (quickcheck
   (property ((bv $bytevector))
     (equal? bv (encode-binary-string (decode-binary-string bv))))))

(test-assert "[prop] Reading produces a valid result"
  (quickcheck
   (property ((bv $bytevector))
     (valid-binary-string? (decode-binary-string bv)))))

(test-assert "[prop] Writing is reversible"
  (quickcheck
   (property ((str $binary-string))
     (test-when (valid-binary-string? str)
       (equal? str (decode-binary-string (encode-binary-string str)))))))

(test-assert "[prop] Serializing is reversible"
  (quickcheck
   (property ((str $binary-string))
     (test-when (valid-binary-string? str)
       (equal? str (serdeser -binary-string- str))))))

(test-end "kinds--binary-string")