From 55c3176934d5e1794549fb5002d30f7c56b9fd93 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 25 Mar 2010 18:14:11 +0000
Subject: [PATCH] Adding a work around for the compiler bug... plus I like it
 better. And adding a regression test for the compiler.

svn: r18619
---
 collects/tests/compiler/regression.ss | 17 ++++++++++++++
 collects/web-server/http/cookie.ss    | 34 ++++++++++++---------------
 2 files changed, 32 insertions(+), 19 deletions(-)
 create mode 100644 collects/tests/compiler/regression.ss

diff --git a/collects/tests/compiler/regression.ss b/collects/tests/compiler/regression.ss
new file mode 100644
index 0000000000..4a2b58fdc4
--- /dev/null
+++ b/collects/tests/compiler/regression.ss
@@ -0,0 +1,17 @@
+#lang scheme
+(require net/cookie
+         tests/eli-tester)
+
+(define (set-when-true fn val)
+  (if val
+      (λ (c) (fn c val))
+      (λ (c) c)))
+
+(define (make-cookie name val)
+  ((lambda (x)
+     ((set-when-true cookie:add-comment #f)
+      x))
+   (set-cookie name val)))
+
+(test
+ (cookie? (make-cookie "name" "value")))
\ No newline at end of file
diff --git a/collects/web-server/http/cookie.ss b/collects/web-server/http/cookie.ss
index 7f69de347e..f6cc9c953e 100644
--- a/collects/web-server/http/cookie.ss
+++ b/collects/web-server/http/cookie.ss
@@ -16,20 +16,16 @@
  [cookie->header (cookie? . -> . header?)]
  [xexpr-response/cookies ((listof cookie?) pretty-xexpr/c . -> . response/full?)])
 
-(define (set-when-true fn val)
-  (if val
-      (λ (c) (fn c val))
-      (λ (c) c)))
-
-(define-syntax o
+(define-syntax setter
   (syntax-rules ()
-    [(o f) f]
-    [(o f f2 ...) (lambda (x) (o* x f f2 ...))]))
-
-(define-syntax o*
-  (syntax-rules ()
-    [(o* x) x]
-    [(o* x f g ...) (f (o* x g ...))]))
+    [(_ e)
+     e]
+    [(_ e (f arg) . more)
+     (let ([x e])
+       (setter (if arg
+                   (f x arg)
+                   x)
+               . more))]))
 
 (define (make-cookie name val
                      #:comment [comment #f]
@@ -37,12 +33,12 @@
                      #:max-age [max-age #f]
                      #:path    [path #f]
                      #:secure? [secure? #f])
-  ((o (set-when-true cookie:add-comment comment)
-      (set-when-true cookie:add-domain domain)
-      (set-when-true cookie:add-max-age max-age)
-      (set-when-true cookie:add-path path)
-      (set-when-true cookie:secure secure?))
-   (set-cookie name val)))
+  (setter (set-cookie name val)
+          (cookie:add-comment comment)
+          (cookie:add-domain domain)
+          (cookie:add-max-age max-age)
+          (cookie:add-path path)
+          (cookie:secure secure?)))
 
 ;; cookie->header : cookie -> header
 ;; gets the header that will set the given cookie