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:
parent
4d097b7bfc
commit
7cc0a1760d
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user