123 lines
5.4 KiB
Racket
123 lines
5.4 KiB
Racket
#lang racket
|
|
(require net/head tests/eli-tester)
|
|
|
|
;; a few tests of head.rkt -- JBC, 2006-07-31
|
|
|
|
(provide tests)
|
|
(module+ main (tests))
|
|
(define (tests)
|
|
(define test-header
|
|
(string-append "From: abc\r\nTo: field is\r\n continued\r\n"
|
|
"Another: zoo\r\n continued\r\n\r\n"))
|
|
(define test-header/bytes
|
|
(bytes-append #"From: abc\r\nTo: field is\r\n continued\r\n"
|
|
#"Another: zoo\r\n continued\r\n\r\n"))
|
|
(test
|
|
|
|
(validate-header "From: me@here.net\r\n\r\n")
|
|
(validate-header #"From: me@here.net\r\n\r\n")
|
|
(validate-header "From: a\r\nTo: b\r\nResent-to: qrv@erocg\r\n\r\n")
|
|
(validate-header #"From: a\r\nTo: b\r\nResent-to: qrv@erocg\r\n\r\n")
|
|
|
|
(validate-header "From: a\r\nTo: b\r\nMissingTrailingrn: qrv@erocg\r\n")
|
|
=error> "missing ending CRLF"
|
|
(validate-header #"From: a\r\nTo: b\r\nMissingTrailingrn: qrv@erocg\r\n")
|
|
=error> "missing ending CRLF"
|
|
(validate-header "From: a\r\nnocolon inthisline\r\n\r\n")
|
|
=error> "ill-formed header"
|
|
(validate-header #"From: a\r\nnocolon inthisline\r\n\r\n")
|
|
=error> "ill-formed header"
|
|
(validate-header "From: a\r\nMissingReturn: och\n\r\n")
|
|
=error> "missing ending CRLF"
|
|
(validate-header #"From: a\r\nMissingReturn: och\n\r\n")
|
|
=error> "missing ending CRLF"
|
|
(validate-header "From: a\r\nSpacein Fieldname: och\r\n\r\n")
|
|
=error> "ill-formed header"
|
|
(validate-header #"From: a\r\nSpacein Fieldname: och\r\n\r\n")
|
|
=error> "ill-formed header"
|
|
|
|
(extract-field "From" test-header)
|
|
=> "abc"
|
|
(extract-field #"From" test-header/bytes)
|
|
=> #"abc"
|
|
(extract-field "To" test-header)
|
|
=> "field is\r\n continued"
|
|
(extract-field #"To" test-header/bytes)
|
|
=> #"field is\r\n continued"
|
|
(extract-field "Another" test-header)
|
|
=> "zoo\r\n continued"
|
|
(extract-field #"Another" test-header/bytes)
|
|
=> #"zoo\r\n continued"
|
|
|
|
(replace-field "From" "def" test-header)
|
|
=> "From: def\r\nTo: field is\r\n continued\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
(replace-field #"From" #"def" test-header/bytes)
|
|
=> #"From: def\r\nTo: field is\r\n continued\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
(replace-field "From" #f test-header)
|
|
=> "To: field is\r\n continued\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
(replace-field #"From" #f test-header/bytes)
|
|
=> #"To: field is\r\n continued\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
|
|
(replace-field "To" "qrs" test-header)
|
|
=> "From: abc\r\nTo: qrs\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
(replace-field #"To" #"qrs" test-header/bytes)
|
|
=> #"From: abc\r\nTo: qrs\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
(replace-field "To" #f test-header)
|
|
=> "From: abc\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
(replace-field #"To" #f test-header/bytes)
|
|
=> #"From: abc\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
|
|
(replace-field "Another" "abc\r\n def" test-header)
|
|
=> "From: abc\r\nTo: field is\r\n continued\r\nAnother: abc\r\n def\r\n\r\n"
|
|
(replace-field #"Another" #"abc\r\n def" test-header/bytes)
|
|
=> #"From: abc\r\nTo: field is\r\n continued\r\nAnother: abc\r\n def\r\n\r\n"
|
|
(replace-field "Another" #f test-header)
|
|
=> "From: abc\r\nTo: field is\r\n continued\r\n\r\n"
|
|
(replace-field #"Another" #f test-header/bytes)
|
|
=> #"From: abc\r\nTo: field is\r\n continued\r\n\r\n"
|
|
|
|
(remove-field "To" test-header)
|
|
=> "From: abc\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
(remove-field #"To" test-header/bytes)
|
|
=> #"From: abc\r\nAnother: zoo\r\n continued\r\n\r\n"
|
|
|
|
(extract-all-fields test-header)
|
|
=> `(("From" . "abc") ("To" . "field is\r\n continued") ("Another" . "zoo\r\n continued"))
|
|
(extract-all-fields test-header/bytes)
|
|
=> `((#"From" . #"abc") (#"To" . #"field is\r\n continued") (#"Another" . #"zoo\r\n continued"))
|
|
|
|
(append-headers test-header "Athird: data\r\n\r\n")
|
|
=> "From: abc\r\nTo: field is\r\n continued\r\nAnother: zoo\r\n continued\r\nAthird: data\r\n\r\n"
|
|
(append-headers test-header/bytes #"Athird: data\r\n\r\n")
|
|
=> #"From: abc\r\nTo: field is\r\n continued\r\nAnother: zoo\r\n continued\r\nAthird: data\r\n\r\n"
|
|
|
|
)
|
|
|
|
(let ([test (lambda (expect f . args)
|
|
(unless (equal? expect (apply f args))
|
|
(error "failed")))])
|
|
(for-each
|
|
(lambda (addr)
|
|
(test '("o.gu@racket-lang.com") extract-addresses (car addr) 'address)
|
|
(test '("o.gu@racket-lang.com" "o.gu@racket-lang.com") extract-addresses
|
|
(format "~a, ~a" (car addr) (car addr))
|
|
'address)
|
|
(test (list (cdr addr)) extract-addresses (car addr) 'name)
|
|
(for-each
|
|
(lambda (addr2)
|
|
(let ([two (format " ~a, \n\t~a" (car addr) (car addr2))])
|
|
(test '("o.gu@racket-lang.com" "s.gu@racket-lang.org") extract-addresses two 'address)
|
|
(test (list (cdr addr) (cdr addr2)) extract-addresses two 'name)))
|
|
'(("s.gu@racket-lang.org" . "s.gu@racket-lang.org")
|
|
("<s.gu@racket-lang.org>" . "s.gu@racket-lang.org")
|
|
("s.gu@racket-lang.org (Gu, Sophia)" . "Gu, Sophia")
|
|
("s.gu@racket-lang.org (Sophia Gu)" . "Sophia Gu")
|
|
("s.gu@racket-lang.org (Sophia \"Sophie\" Gu)" . "Sophia \"Sophie\" Gu")
|
|
("Sophia Gu <s.gu@racket-lang.org>" . "Sophia Gu")
|
|
("\"Gu, Sophia\" <s.gu@racket-lang.org>" . "\"Gu, Sophia\"")
|
|
("\"Gu, Sophia (Sophie)\" <s.gu@racket-lang.org>" . "\"Gu, Sophia (Sophie)\""))))
|
|
'(("o.gu@racket-lang.com" . "o.gu@racket-lang.com")))
|
|
(printf "more tests passed\n")))
|
|
|
|
(module+ test (require (submod ".." main))) ; for raco test & drdr
|