Fixing PR13729

original commit: 7afde31fa6
This commit is contained in:
Jay McCarthy 2013-05-06 07:22:56 -06:00
parent 7b40eb66b7
commit 04d012960f
2 changed files with 21 additions and 19 deletions

View File

@ -130,7 +130,7 @@
(format-if "Max-Age=~a" (cookie-max-age cookie)) (format-if "Max-Age=~a" (cookie-max-age cookie))
(format-if "Path=~a" (cookie-path cookie)) (format-if "Path=~a" (cookie-path cookie))
(and (cookie-secure cookie) "Secure") (and (cookie-secure cookie) "Secure")
(format "Version=~a" (or (cookie-version cookie) 1)) (format-if "Version=~a" (cookie-version cookie))
(format-if "expires=~a" (cookie-expires cookie)))) (format-if "expires=~a" (cookie-expires cookie))))
"; ")) "; "))
@ -166,7 +166,7 @@
cookie) cookie)
(define (cookie:add-path cookie pre-path) (define (cookie:add-path cookie pre-path)
(let ([path (to-rfc2109:value pre-path)]) (let ([path pre-path])
(unless (cookie? cookie) (unless (cookie? cookie)
(error* "cookie expected, received: ~a" cookie)) (error* "cookie expected, received: ~a" cookie))
(set-cookie-path! cookie path) (set-cookie-path! cookie path)

View File

@ -24,49 +24,49 @@
(define (tests) (define (tests)
;; test the most basic functionality ;; test the most basic functionality
(cookie-test (λ (x) x) "a=b; Version=1") (cookie-test (λ (x) x) "a=b")
;; test each modifier individually ;; test each modifier individually
(cookie-test (RC cookie:add-comment "set+a+to+b") (cookie-test (RC cookie:add-comment "set+a+to+b")
"a=b; Comment=set+a+to+b; Version=1") "a=b; Comment=set+a+to+b")
(cookie-test (RC cookie:add-comment "a comment with spaces") (cookie-test (RC cookie:add-comment "a comment with spaces")
"a=b; Comment=\"a comment with spaces\"; Version=1") "a=b; Comment=\"a comment with spaces\"")
(cookie-test (RC cookie:add-comment "the \"risks\" involved in waking") (cookie-test (RC cookie:add-comment "the \"risks\" involved in waking")
"a=b; Comment=\"the \\\"risks\\\" involved in waking\"; Version=1") "a=b; Comment=\"the \\\"risks\\\" involved in waking\"")
(cookie-test (RC cookie:add-comment "\"already formatted\"") (cookie-test (RC cookie:add-comment "\"already formatted\"")
"a=b; Comment=\"already formatted\"; Version=1") "a=b; Comment=\"already formatted\"")
(cookie-test (RC cookie:add-comment "\"problematic \" internal quote\"") (cookie-test (RC cookie:add-comment "\"problematic \" internal quote\"")
"a=b; Comment=\"\\\"problematic \\\" internal quote\\\"\"; Version=1") "a=b; Comment=\"\\\"problematic \\\" internal quote\\\"\"")
(cookie-test (RC cookie:add-comment "contains;semicolon") (cookie-test (RC cookie:add-comment "contains;semicolon")
"a=b; Comment=\"contains;semicolon\"; Version=1") "a=b; Comment=\"contains;semicolon\"")
(cookie-test (RC cookie:add-domain ".example.net") (cookie-test (RC cookie:add-domain ".example.net")
"a=b; Domain=.example.net; Version=1") "a=b; Domain=.example.net")
(cookie-test (RC cookie:add-max-age 100) (cookie-test (RC cookie:add-max-age 100)
"a=b; Max-Age=100; Version=1") "a=b; Max-Age=100")
(cookie-test (RC cookie:add-path "/whatever/wherever/") (cookie-test (RC cookie:add-path "/whatever/wherever/")
"a=b; Path=\"/whatever/wherever/\"; Version=1") "a=b; Path=/whatever/wherever/")
(cookie-test (RC cookie:add-path "a+path") (cookie-test (RC cookie:add-path "a+path")
"a=b; Path=a+path; Version=1") "a=b; Path=a+path")
(cookie-test (RC cookie:add-path "\"/already/quoted/\"") (cookie-test (RC cookie:add-path "\"/already/quoted/\"")
"a=b; Path=\"/already/quoted/\"; Version=1") "a=b; Path=\"/already/quoted/\"")
(cookie-test (RC cookie:secure #t) (cookie-test (RC cookie:secure #t)
"a=b; Secure; Version=1") "a=b; Secure")
(cookie-test (RC cookie:secure #f) (cookie-test (RC cookie:secure #f)
"a=b; Version=1") "a=b")
(cookie-test (RC cookie:version 12) (cookie-test (RC cookie:version 12)
"a=b; Version=12") "a=b; Version=12")
;; test combinations ;; test combinations
(cookie-test (o (RC cookie:add-comment "set+a+to+b") (cookie-test (o (RC cookie:add-comment "set+a+to+b")
(RC cookie:add-domain ".example.net")) (RC cookie:add-domain ".example.net"))
"a=b; Comment=set+a+to+b; Domain=.example.net; Version=1") "a=b; Comment=set+a+to+b; Domain=.example.net")
(cookie-test (o (RC cookie:add-max-age 300) (cookie-test (o (RC cookie:add-max-age 300)
(RC cookie:secure #t)) (RC cookie:secure #t))
"a=b; Max-Age=300; Secure; Version=1") "a=b; Max-Age=300; Secure")
(cookie-test (o (RC cookie:add-path "/whatever/wherever/") (cookie-test (o (RC cookie:add-path "/whatever/wherever/")
(RC cookie:version 10) (RC cookie:version 10)
(RC cookie:add-max-age 20)) (RC cookie:add-max-age 20))
"a=b; Max-Age=20; Path=\"/whatever/wherever/\"; Version=10") "a=b; Max-Age=20; Path=/whatever/wherever/; Version=10")
;; test error cases ;; test error cases
(let () (let ()
@ -91,6 +91,8 @@
(cookie-value? "(!)") (cookie-value? "(!)")
(cookie-value? "!)")) (cookie-value? "!)"))
) )
(test do (tests))) (test do (tests)))