Added a test suite for net/cookie.ss, and fixed some bugs revealed by that test suite

svn: r5010

original commit: 7c7ada4514
This commit is contained in:
Jacob Matthews 2006-12-03 00:02:40 +00:00
parent 4d097b7bfc
commit 7cc0a1760d

View File

@ -491,6 +491,79 @@
(test #"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")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; cookie tests --- JBM, 2006-12-01
(require (lib "cookie.ss" "net"))
;; cookie-test : (cookie -> cookie) string -> test
(define (cookie-test fn expected)
(test expected
(λ (c) (print-cookie (fn c)))
(set-cookie "a" "b")))
;; RC = "reverse curry"
(define (RC f arg2) (λ (arg1) (f arg1 arg2)))
;; o = compose
(define-syntax o
(syntax-rules ()
[(o f) f]
[(o f g h ...)
(λ (x) (o/* x f g h ...))]))
(define-syntax o/*
(syntax-rules ()
[(o/* x) x]
[(o/* x f g ...)
(f (o/* x g ...))]))
;; test the most basic functionality
(cookie-test (λ (x) x) "a=b; Version=1")
;; test each modifier individually
(cookie-test (RC cookie:add-comment "set+a+to+b") "a=b; Comment=set+a+to+b; Version=1")
(cookie-test (RC cookie:add-comment "a comment with spaces") "a=b; Comment=\"a comment with spaces\"; Version=1")
(cookie-test (RC cookie:add-comment "the \"risks\" involved in waking")
"a=b; Comment=\"the \\\"risks\\\" involved in waking\"; Version=1")
(cookie-test (RC cookie:add-comment "\"already formatted\"")
"a=b; Comment=\"already formatted\"; Version=1")
(cookie-test (RC cookie:add-comment "\"problematic \" internal quote\"")
"a=b; Comment=\"\\\"problematic \\\" internal quote\\\"\"; Version=1")
(cookie-test (RC cookie:add-comment "contains;semicolon")
"a=b; Comment=\"contains;semicolon\"; Version=1")
(cookie-test (RC cookie:add-domain ".example.net") "a=b; Domain=.example.net; Version=1")
(cookie-test (RC cookie:add-max-age 100) "a=b; Max-Age=100; Version=1")
(cookie-test (RC cookie:add-path "/whatever/wherever/") "a=b; Path=\"/whatever/wherever/\"; Version=1")
(cookie-test (RC cookie:add-path "a+path") "a=b; Path=a+path; Version=1")
(cookie-test (RC cookie:add-path "\"/already/quoted/\"") "a=b; Path=\"/already/quoted/\"; Version=1")
(cookie-test (RC cookie:secure #t) "a=b; Secure; Version=1")
(cookie-test (RC cookie:secure #f) "a=b; Version=1")
(cookie-test (RC cookie:version 12) "a=b; Version=12")
;; test combinations
(cookie-test (o (RC cookie:add-comment "set+a+to+b")
(RC cookie:add-domain ".example.net"))
"a=b; Comment=set+a+to+b; Domain=.example.net; Version=1")
(cookie-test (o (RC cookie:add-max-age 300)
(RC cookie:secure #t))
"a=b; Max-Age=300; Secure; Version=1")
(cookie-test (o (RC cookie:add-path "/whatever/wherever/")
(RC cookie:version 10)
(RC cookie:add-max-age 20))
"a=b; Max-Age=20; Path=\"/whatever/wherever/\"; Version=10")
;; test error cases
(define-syntax cookie-error-test
(syntax-rules ()
[(cookie-error-test e)
(thunk-error-test (λ () (e (set-cookie "a" "b"))) #'e cookie-error?)]))
(cookie-error-test (RC cookie:add-comment "illegal character #\000"))
(cookie-error-test (RC cookie:add-max-age -10))
(cookie-error-test (RC cookie:add-domain "doesntstartwithadot.example.com"))
(cookie-error-test (RC cookie:add-domain "bad domain.com"))
(cookie-error-test (RC cookie:add-domain ".bad-domain;com"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; other net tests