#lang scheme/base
;; See randtok.ss for legal information.
;; $Id: test-randtok.ss,v 1.1 2009/06/07 17:45:22 neilpair Exp $

(require "randtok.ss")

;; (define (%write-byte-as-bits byte)
;;   (for-each (lambda (n)
;;               (write-char (if (bitwise-bit-set? byte n) #\1 #\0)))
;;             '(7 6 5 4 3 2 1 0)))
;;
;; (define (%write-partial-byte-as-bits byte num-bits)
;;   ;; TODO: error-check num-bits is positive integer.
;;   (let loop ((i (- num-bits 1)))
;;     (write-char (if (bitwise-bit-set? byte i) #\1 #\0))
;;     (if (zero? i)
;;         (void)
;;         (loop (- i 1)))))
;;
;; (let* ((rand-bytes-len 10)
;;        (rand-bytes-list (let loop ((i rand-bytes-len))
;;                           (if (zero? i)
;;                               '()
;;                               (cons (random 256)
;;                                     (loop (- i 1))))))
;;        (rand-bytes (apply bytes rand-bytes-list)))
;;
;;   (newline)
;;
;;   (display "     input : ")
;;   (for-each %write-byte-as-bits rand-bytes-list)
;;   (newline)
;;
;;   (for-each
;;    (lambda (input)
;;      (let ((prefix (car input))
;;            (maker  (cdr input)))
;;        (let loop-num-bits ((num-bits 8))
;;          (or (zero? num-bits)
;;              (let ((bits-must-be-less-than (expt 2 num-bits)))
;;                (printf "~A-~A : " prefix num-bits)
;;                (let* ((in        (open-input-bytes rand-bytes))
;;                       ;; Note: We don't currently test max-bits.
;;                       (read-bits (maker in num-bits)))
;;                  (let loop ((times (truncate (/ (* 8 rand-bytes-len)
;;                                                 num-bits))))
;;                    (if (zero? times)
;;                        (begin (newline)
;;                               (close-input-port in)
;;                               (loop-num-bits (- num-bits 1)))
;;                        (let ((bits (read-bits)))
;;                          (or (< bits bits-must-be-less-than)
;;                              (error
;;                               '<tests>
;;                               "read bits value of ~S but num-bits is ~S"
;;                               bits
;;                               num-bits))
;;                          (%write-partial-byte-as-bits bits num-bits)
;;                          (loop (- times 1)))))))))))
;;    `(("variable" . ,(lambda (in num-bits)
;;                       (let ((read-bits (%make-variable-bit-reader in)))
;;                         (lambda ()
;;                           (read-bits num-bits)))))
;;      ("   fixed" . ,(lambda (in num-bits)
;;                       (%make-fixed-bit-reader in num-bits)))))
;;
;;   (newline))

;; EOF