111 lines
4.5 KiB
Racket
111 lines
4.5 KiB
Racket
#lang scheme
|
|
(require net/base64 net/qp tests/eli-tester)
|
|
|
|
(define tricky-strings
|
|
(let ([dir (collection-path "tests" "racket")])
|
|
(list (make-bytes 200 32)
|
|
(make-bytes 200 9)
|
|
(make-bytes 200 (char->integer #\x))
|
|
(make-bytes 201 (char->integer #\x))
|
|
(make-bytes 202 (char->integer #\x))
|
|
(make-bytes 203 (char->integer #\x))
|
|
(make-bytes 204 (char->integer #\x))
|
|
(list->bytes (for/list ([i (in-range 256)]) i))
|
|
;; Something that doesn't end with a LF:
|
|
(bytes-append (with-input-from-file (build-path dir "net.rktl")
|
|
(lambda () (read-bytes 500)))
|
|
#"xxx")
|
|
;; CRLF:
|
|
(regexp-replace #rx#"\r?\n"
|
|
(with-input-from-file (build-path dir "net.rktl")
|
|
(lambda () (read-bytes 500)))
|
|
#"\r\n"))))
|
|
|
|
(define (check-same encode decode port line-rx max-w)
|
|
(let ([p (open-output-bytes)])
|
|
(copy-port port p)
|
|
(let ([bytes (get-output-bytes p)]
|
|
[r (open-output-bytes)])
|
|
(encode (open-input-bytes bytes) r)
|
|
(let ([p (open-input-bytes (get-output-bytes r))])
|
|
(let loop ()
|
|
(let ([l (read-bytes-line p 'any)])
|
|
(unless (eof-object? l)
|
|
(test ; #:failure-message (format "line too long; ~s" encode)
|
|
(<= (bytes-length l) max-w))
|
|
(let ([m (regexp-match-positions line-rx l)])
|
|
(test ; #:failure-message (format "bad line; ~s" encode)
|
|
(and m (= (bytes-length l) (cdar m)))))
|
|
(loop))))
|
|
(let ([q (open-output-bytes)])
|
|
(decode (open-input-bytes (get-output-bytes r)) q)
|
|
(unless (equal? (get-output-bytes q) bytes)
|
|
(with-output-to-file "/tmp/x0" (lambda () (display (get-output-bytes r))) 'truncate)
|
|
(with-output-to-file "/tmp/x1" (lambda () (display (get-output-bytes q))) 'truncate)
|
|
(with-output-to-file "/tmp/x2" (lambda () (display bytes)) 'truncate)
|
|
(error 'decode "failed")))))))
|
|
|
|
(define ((check-same-file encode decode line-rx max-w) file)
|
|
(call-with-input-file file
|
|
(lambda (p) (check-same encode decode p line-rx max-w))))
|
|
|
|
(define (check-same-all encode decode line-rx max-w)
|
|
(for-each (lambda (tricky-string)
|
|
(check-same encode decode
|
|
(open-input-bytes tricky-string)
|
|
line-rx max-w))
|
|
tricky-strings)
|
|
(let* ([dir (collection-path "tests" "racket")]
|
|
[files (filter-map
|
|
(lambda (f)
|
|
;; check 1/4 of the files, randomly
|
|
(let ([p (build-path dir f)])
|
|
(and (zero? (random 4))
|
|
(not (regexp-match #rx"^flat.*\\.rktl$"
|
|
(path-element->string f)))
|
|
(file-exists? p)
|
|
p)))
|
|
(directory-list dir))])
|
|
(for-each (check-same-file encode decode line-rx max-w) files)))
|
|
|
|
(provide tests)
|
|
(module+ main (tests))
|
|
(define (tests)
|
|
(test
|
|
do (check-same-all (lambda (i o) (qp-encode-stream i o))
|
|
qp-decode-stream
|
|
#rx#"^(|[\t \41-\176]*[\41-\176]+)$"
|
|
76)
|
|
do (check-same-all base64-encode-stream
|
|
base64-decode-stream
|
|
#rx#"^[0-9a-zA-Z+=/]*$"
|
|
72)))
|
|
|
|
#|
|
|
Use this to compare base64 encode/decode against the unix utilities
|
|
(require net/base64 scheme/system)
|
|
(define (base64-encode* bstr)
|
|
(let ([o (open-output-bytes)])
|
|
(parameterize ([current-output-port o]
|
|
[current-input-port (open-input-bytes bstr)])
|
|
(system "base64-encode"))
|
|
(let* ([o (get-output-bytes o)]
|
|
[o (regexp-replace #rx#"(.)(?:\r?\n)?$" o #"\\1\r\n")]
|
|
[o (regexp-replace* #rx#"\r?\n" o #"\r\n")])
|
|
o)))
|
|
(define (base64-decode* bstr)
|
|
(let ([o (open-output-bytes)])
|
|
(parameterize ([current-output-port o]
|
|
[current-input-port (open-input-bytes bstr)])
|
|
(system "base64-decode"))
|
|
(get-output-bytes o)))
|
|
(define (check-base64-encode bstr)
|
|
(equal? (base64-encode bstr) (base64-encode* bstr)))
|
|
(define (check-base64-decode bstr)
|
|
(equal? (base64-decode bstr) (base64-decode* bstr)))
|
|
(define (check-base64-both bstr)
|
|
(let ([en (base64-encode bstr)])
|
|
(and (equal? en (base64-encode* bstr))
|
|
(equal? (base64-decode en) (base64-decode* en)))))
|
|
|#
|