summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-08-21 10:39:19 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2011-08-21 10:39:19 -0400
commitf1096b0e7bd380e9ccfb1438548596fe9e9ab5e9 (patch)
treeb0ef9231c9c1bc61859d262a876bc1549c5103c7
parent0156bf0da091dd2a773c08c2917c121bc86643bb (diff)
Fix crash in list unurlification
-rw-r--r--src/cjr_print.sml27
-rw-r--r--tests/rpcList2.ur7
2 files changed, 23 insertions, 11 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 159948b3..fb36e36e 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -541,16 +541,21 @@ val unurlifies = ref IS.empty
fun unurlify fromClient env (t, loc) =
let
+ fun deStar request =
+ case request of
+ "(*request)" => "request"
+ | _ => "&" ^ request
+
fun unurlify' request t =
case t of
- TFfi ("Basis", "unit") => string ("uw_Basis_unurlifyUnit(ctx, &" ^ request ^ ")")
+ TFfi ("Basis", "unit") => string ("uw_Basis_unurlifyUnit(ctx, " ^ deStar request ^ ")")
| TFfi ("Basis", "string") => string (if fromClient then
- "uw_Basis_unurlifyString_fromClient(ctx, &" ^ request ^ ")"
+ "uw_Basis_unurlifyString_fromClient(ctx, " ^ deStar request ^ ")"
else
- "uw_Basis_unurlifyString(ctx, &" ^ request ^ ")")
- | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, &" ^ request ^ ")")
+ "uw_Basis_unurlifyString(ctx, " ^ deStar request ^ ")")
+ | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, " ^ deStar request ^ ")")
- | TRecord 0 => string ("uw_Basis_unurlifyUnit(ctx, &" ^ request ^ ")")
+ | TRecord 0 => string ("uw_Basis_unurlifyUnit(ctx, " ^ deStar request ^ ")")
| TRecord i =>
let
val xts = E.lookupStruct env i
@@ -623,7 +628,7 @@ fun unurlify fromClient env (t, loc) =
if IS.member (!unurlifies, i) then
box [string "unurlify_",
string (Int.toString i),
- string ("(ctx, &" ^ request ^ ")")]
+ string ("(ctx, " ^ deStar request ^ ")")]
else
let
val (x, _) = E.lookupDatatype env i
@@ -721,7 +726,7 @@ fun unurlify fromClient env (t, loc) =
if IS.member (!unurlifies, i) then
box [string "unurlify_",
string (Int.toString i),
- string ("(ctx, &" ^ request ^ ")")]
+ string ("(ctx, " ^ deStar request ^ ")")]
else
let
val (x, xncs) = E.lookupDatatype env i
@@ -807,14 +812,14 @@ fun unurlify fromClient env (t, loc) =
box [string "unurlify_",
string (Int.toString i),
- string ("(ctx, &" ^ request ^ ")")]
+ string ("(ctx, " ^ deStar request ^ ")")]
end
| TList (t', i) =>
if IS.member (!unurlifies, i) then
box [string "unurlify_list_",
string (Int.toString i),
- string ("(ctx, &" ^ request ^ ")")]
+ string ("(ctx, " ^ deStar request ^ ")")]
else
(unurlifies := IS.add (!unurlifies, i);
addUrlHandler (box [string "static",
@@ -832,7 +837,7 @@ fun unurlify fromClient env (t, loc) =
space,
string "+=",
space,
- string "3, ((*request)[0] == '/' ? *request++ = 0 : 0), NULL) : ((!strncmp(*request, \"Cons\", 4) && ((*request)[4] == 0 ",
+ string "3, ((*request)[0] == '/' ? ((*request)[0] = 0, (*request)++) : NULL)) : ((!strncmp(*request, \"Cons\", 4) && ((*request)[4] == 0 ",
string "|| (*request)[4] == '/')) ? (*request",
space,
string "+=",
@@ -874,7 +879,7 @@ fun unurlify fromClient env (t, loc) =
box [string "unurlify_list_",
string (Int.toString i),
- string ("(ctx, &" ^ request ^ ")")])
+ string ("(ctx, " ^ deStar request ^ ")")])
| TOption t =>
box [string ("(" ^ request ^ "[0] == '/' ? ++" ^ request ^ " : " ^ request ^ ", "),
diff --git a/tests/rpcList2.ur b/tests/rpcList2.ur
new file mode 100644
index 00000000..c0739b84
--- /dev/null
+++ b/tests/rpcList2.ur
@@ -0,0 +1,7 @@
+fun rpcFunc l : transaction {} = return ()
+
+fun main () : transaction page = return <xml><body>
+ <button onclick={
+ rpc (rpcFunc (("" :: []) :: []))
+ }/>
+ </body></xml>