diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2011-08-21 10:39:19 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2011-08-21 10:39:19 -0400 |
| commit | f1096b0e7bd380e9ccfb1438548596fe9e9ab5e9 (patch) | |
| tree | b0ef9231c9c1bc61859d262a876bc1549c5103c7 | |
| parent | 0156bf0da091dd2a773c08c2917c121bc86643bb (diff) | |
Fix crash in list unurlification
| -rw-r--r-- | src/cjr_print.sml | 27 | ||||
| -rw-r--r-- | tests/rpcList2.ur | 7 |
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> |