changeset 1423:bd6c90f5a428

Fix some cookie-related bugs in MonoReduce
author Adam Chlipala <adam@chlipala.net>
date Thu, 10 Feb 2011 08:46:46 -0500
parents 07ef5771568d
children 7f6ac9f33d4d
files src/mono_reduce.sml tests/cookieClear.ur tests/cookieClear.urp tests/cookieClear.urs
diffstat 4 files changed, 28 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/src/mono_reduce.sml	Tue Feb 08 16:54:01 2011 -0500
+++ b/src/mono_reduce.sml	Thu Feb 10 08:46:46 2011 -0500
@@ -76,7 +76,7 @@
       | EDml _ => true
       | ENextval _ => true
       | ESetval _ => true
-      | EUnurlify _ => false
+      | EUnurlify (e, _, _) => impure e
       | EAbs _ => false
 
       | EPrim _ => false
@@ -395,6 +395,10 @@
                       | EFfi _ => []
                       | EFfiApp ("Basis", "get_cookie", [e]) =>
                         summarize d e @ [ReadCookie]
+                      | EFfiApp ("Basis", "set_cookie", es) =>
+                        List.concat (map (summarize d) es) @ [WriteCookie]
+                      | EFfiApp ("Basis", "clear_cookie", es) =>
+                        List.concat (map (summarize d) es) @ [WriteCookie]
                       | EFfiApp (m, x, es) =>
                         if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then
                             List.concat (map (summarize d) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then
@@ -523,8 +527,8 @@
                                 val r = subExpInExp (0, e') b
                             in
                                 (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
-                                                          ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
-                                                          ("r", MonoPrint.p_exp env r)];*)
+                                                        ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+                                                        ("r", MonoPrint.p_exp env r)];*)
                                 #1 (reduceExp env r)
                             end
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cookieClear.ur	Thu Feb 10 08:46:46 2011 -0500
@@ -0,0 +1,19 @@
+cookie c : int
+
+fun setit () =
+    setCookie c {Value = 13,
+                 Expires = None,
+                 Secure = False};
+    return <xml/>
+
+fun doit () =
+    ro <- getCookie c;
+    clearCookie c;
+    case ro of
+      None => return <xml>None</xml>
+    | Some v => return <xml>Some {[v]}</xml>
+
+fun main () = return <xml><body>
+  <form><submit value="Set it!" action={setit}/></form>
+  <form><submit value="Get busy!" action={doit}/></form>
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cookieClear.urp	Thu Feb 10 08:46:46 2011 -0500
@@ -0,0 +1,1 @@
+cookieClear
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cookieClear.urs	Thu Feb 10 08:46:46 2011 -0500
@@ -0,0 +1,1 @@
+val main : unit -> transaction page