summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-02-10 08:46:46 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2011-02-10 08:46:46 -0500
commitf45895094211495b2aec63541b97e61b71abf289 (patch)
tree189de6f2ff8814313cf52d2fafc2a2d266806c26
parent7db27b06d50316f07bb38ddc5999d086be911ed2 (diff)
Fix some cookie-related bugs in MonoReduce
-rw-r--r--src/mono_reduce.sml10
-rw-r--r--tests/cookieClear.ur19
-rw-r--r--tests/cookieClear.urp1
-rw-r--r--tests/cookieClear.urs1
4 files changed, 28 insertions, 3 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 82d0a63d..15549175 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -76,7 +76,7 @@ fun impure (e, _) =
| EDml _ => true
| ENextval _ => true
| ESetval _ => true
- | EUnurlify _ => false
+ | EUnurlify (e, _, _) => impure e
| EAbs _ => false
| EPrim _ => false
@@ -395,6 +395,10 @@ fun reduce file =
| 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 @@ fun reduce file =
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
diff --git a/tests/cookieClear.ur b/tests/cookieClear.ur
new file mode 100644
index 00000000..70829808
--- /dev/null
+++ b/tests/cookieClear.ur
@@ -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>
diff --git a/tests/cookieClear.urp b/tests/cookieClear.urp
new file mode 100644
index 00000000..c5a1c837
--- /dev/null
+++ b/tests/cookieClear.urp
@@ -0,0 +1 @@
+cookieClear
diff --git a/tests/cookieClear.urs b/tests/cookieClear.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/cookieClear.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page