97 lines
3.7 KiB
Racket
97 lines
3.7 KiB
Racket
#lang scheme
|
|
(require net/cookie tests/eli-tester)
|
|
|
|
;; cookie tests --- JBM, 2006-12-01
|
|
|
|
(provide tests)
|
|
(module+ main (tests))
|
|
(define (tests)
|
|
;; cookie-test : (cookie -> cookie) string -> test
|
|
(define (cookie-test fn expected)
|
|
(test (print-cookie (fn (set-cookie "a" "b"))) => expected))
|
|
;; 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 ...))]))
|
|
|
|
(define (tests)
|
|
|
|
;; 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
|
|
(let ()
|
|
(define-syntax cookie-error-test
|
|
(syntax-rules ()
|
|
[(cookie-error-test e)
|
|
(test (e (set-cookie "a" "b")) =error> 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")))
|
|
|
|
; cookie value
|
|
(test
|
|
(cookie-value? "value")
|
|
(cookie-value? "(")
|
|
(cookie-value? "!")
|
|
(cookie-value? ")")
|
|
(cookie-value? ")!")
|
|
(cookie-value? "(!")
|
|
(cookie-value? "(!)")
|
|
(cookie-value? "!)"))
|
|
|
|
)
|
|
|
|
(test do (tests)))
|