suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more base64-related changes

Browse Source 
svn: r11470

original commit: 20e9673028
This commit is contained in:
Eli Barzilay 2008-08-28 21:00:53 +00:00
parent 9b6503df48
commit 8b65f4ac26
1 changed files with 98 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

161
collects/tests/mzscheme/net.ss
View File

@ -9,7 +9,7 @@
;; ;;
(require net/url (require net/url
net/uri-codec net/uri-codec
mzlib/string mzlib/string
) )
@ -35,12 +35,12 @@
form-urlencoded->alist "x=foo&y=bar;z=baz") form-urlencoded->alist "x=foo&y=bar;z=baz")
(parameterize ([current-alist-separator-mode 'semi]) (parameterize ([current-alist-separator-mode 'semi])
(test '((a . "hel+lo&b=good-bye")) form-urlencoded->alist (test '((a . "hel+lo&b=good-bye")) form-urlencoded->alist
(parameterize ([current-alist-separator-mode 'amp]) (parameterize ([current-alist-separator-mode 'amp])
(alist->form-urlencoded '((a . "hel+lo") (b . "good-bye")))))) (alist->form-urlencoded '((a . "hel+lo") (b . "good-bye"))))))
(parameterize ([current-alist-separator-mode 'amp]) (parameterize ([current-alist-separator-mode 'amp])
(test '((a . "hel+lo;b=good-bye")) form-urlencoded->alist (test '((a . "hel+lo;b=good-bye")) form-urlencoded->alist
(parameterize ([current-alist-separator-mode 'semi]) (parameterize ([current-alist-separator-mode 'semi])
(alist->form-urlencoded '((a . "hel+lo") (b . "good-bye")))))) (alist->form-urlencoded '((a . "hel+lo") (b . "good-bye"))))))
(test "aNt=Hi" alist->form-urlencoded '((aNt . "Hi"))) (test "aNt=Hi" alist->form-urlencoded '((aNt . "Hi")))
(test '((aNt . "Hi")) form-urlencoded->alist (alist->form-urlencoded '((aNt . "Hi")))) (test '((aNt . "Hi")) form-urlencoded->alist (alist->form-urlencoded '((aNt . "Hi"))))
(test "aNt=Hi" alist->form-urlencoded (form-urlencoded->alist "aNt=Hi")) (test "aNt=Hi" alist->form-urlencoded (form-urlencoded->alist "aNt=Hi"))
@ -57,7 +57,7 @@
(lambda () (lambda ()
;; Test all ASCII chars ;; Test all ASCII chars
(let ([p (let loop ([n 0]) (let ([p (let loop ([n 0])
(if (= n 128) (if (= n 128)
null null
(let ([s (string (char-downcase (integer->char n)))]) (let ([s (string (char-downcase (integer->char n)))])
(cons (cons (string->symbol s) s) (cons (cons (string->symbol s) s)
@ -649,85 +649,118 @@
;; ;;
(require net/base64 (require net/base64
net/qp net/qp
mzlib/port) mzlib/port)
(define tricky-strings (define tricky-strings
(let ([dir (collection-path "tests" "mzscheme")]) (let ([dir (collection-path "tests" "mzscheme")])
(list (make-bytes 200 32) (list (make-bytes 200 32)
(make-bytes 200 9) (make-bytes 200 9)
(make-bytes 200 (char->integer #\x)) (make-bytes 200 (char->integer #\x))
(list->bytes (make-bytes 201 (char->integer #\x))
(let loop ([i 0]) (make-bytes 202 (char->integer #\x))
(if (= i 256) (make-bytes 203 (char->integer #\x))
null (make-bytes 204 (char->integer #\x))
(cons i (loop (add1 i)))))) (list->bytes
;; Something that doesn't end with a LF: (let loop ([i 0])
(bytes-append (if (= i 256)
(with-input-from-file (build-path dir "net.ss") (lambda () (read-bytes 500))) null
#"xxx") (cons i (loop (add1 i))))))
;; CRLF: ;; Something that doesn't end with a LF:
(regexp-replace (bytes-append (with-input-from-file (build-path dir "net.ss")
#rx#"\n" (lambda () (read-bytes 500)))
(with-input-from-file (build-path dir "net.ss") (lambda () (read-bytes 500))) #"xxx")
#"\r\n")))) ;; CRLF:
(regexp-replace #rx#"\r?\n"
(with-input-from-file (build-path dir "net.ss")
(lambda () (read-bytes 500)))
#"\r\n"))))
(define (check-same encode decode port line-rx max-w) (define (check-same encode decode port line-rx max-w)
(let ([p (open-output-bytes)]) (let ([p (open-output-bytes)])
(copy-port port p) (copy-port port p)
(let ([bytes (get-output-bytes p)] (let ([bytes (get-output-bytes p)]
[r (open-output-bytes)]) [r (open-output-bytes)])
(encode (open-input-bytes bytes) r) (encode (open-input-bytes bytes) r)
(let ([p (open-input-bytes (get-output-bytes r))]) (let ([p (open-input-bytes (get-output-bytes r))])
(let loop () (let loop ()
(let ([l (read-bytes-line p 'any)]) (let ([l (read-bytes-line p 'any)])
(unless (eof-object? l) (unless (eof-object? l)
(unless (<= (bytes-length l) max-w) (unless (<= (bytes-length l) max-w)
(test encode "line too long" l)) (test encode "line too long" l))
(let ([m (regexp-match-positions line-rx l)]) (let ([m (regexp-match-positions line-rx l)])
(unless (and m (unless (and m (= (bytes-length l) (cdar m)))
(= (bytes-length l) (cdar m))) (test encode 'bad-line l)))
(test encode 'bad-line l))) (loop))))
(loop)))) (let ([q (open-output-bytes)])
(let ([q (open-output-bytes)]) (decode (open-input-bytes (get-output-bytes r)) q)
(decode (open-input-bytes (get-output-bytes r)) q) (unless (equal? (get-output-bytes q) bytes)
(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/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/x1" (lambda () (display (get-output-bytes q))) 'truncate) (with-output-to-file "/tmp/x2" (lambda () (display bytes)) 'truncate)
(with-output-to-file "/tmp/x2" (lambda () (display bytes)) 'truncate) (error 'decode "failed")))))))
(error 'decode "failed")))))))
(define (check-same-file encode decode file line-rx max-w) (define ((check-same-file encode decode line-rx max-w) file)
;; This "test" is really just a progress report: ;; This "test" is really just a progress report:
(test #t list? (list file encode)) (test #t list? (list file encode))
(call-with-input-file file (call-with-input-file file
(lambda (p) (lambda (p) (check-same encode decode p line-rx max-w))))
(check-same encode decode p line-rx max-w))))
(define (check-same-all encode decode line-rx max-w) (define (check-same-all encode decode line-rx max-w)
(for-each (lambda (tricky-string) (for-each (lambda (tricky-string)
(check-same encode decode (check-same encode decode
(open-input-bytes tricky-string) (open-input-bytes tricky-string)
line-rx max-w)) line-rx max-w))
tricky-strings) tricky-strings)
(parameterize ([current-pseudo-random-generator (make-pseudo-random-generator)]) (let* ([dir (collection-path "tests" "mzscheme")]
(random-seed 17) [files (filter-map (lambda (f)
(let ([dir (collection-path "tests" "mzscheme")]) ;; check 1/3 of the files, randomly
(for-each (lambda (p) (let ([p (build-path dir f)])
(when (regexp-match #rx"[.]ss$" (path->string p)) (and (zero? (random 3))
(unless (or (positive? (random 10)) ; check random 1/10 of files (not (regexp-match
(equal? (path->string p) "flat.ss")) #rx"^flat.*\\.ss$"
(check-same-file encode decode (build-path dir p) line-rx max-w)))) (path-element->string f)))
(directory-list dir))))) (file-exists? p)
p)))
(directory-list dir))])
(for-each (check-same-file encode decode line-rx max-w) files)))
(check-same-all (lambda (i o) (qp-encode-stream i o)) (check-same-all (lambda (i o) (qp-encode-stream i o))
qp-decode-stream qp-decode-stream
#rx#"^(|[\t \41-\176]*[\41-\176]+)$" #rx#"^(|[\t \41-\176]*[\41-\176]+)$"
76) 76)
(check-same-all base64-encode-stream (check-same-all base64-encode-stream
base64-decode-stream base64-decode-stream
#rx#"^[0-9a-zA-Z+=/]*$" #rx#"^[0-9a-zA-Z+=/]*$"
72) 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)))))
|#
(report-errs) (report-errs)