summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-11-25 09:03:08 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-11-25 09:03:08 -0500
commit13d3b41094079577a858394088ddbf74e56c780d (patch)
tree9c1550161f62841c83d9b8ccb39a6756305737b8
parente3e85099d748fb60653ed1f8d7ad06831ef490b7 (diff)
Better error message for link-handler conflicts
-rw-r--r--src/tag.sml9
-rw-r--r--tests/both.ur9
-rw-r--r--tests/both.urp2
-rw-r--r--tests/both2.ur14
-rw-r--r--tests/both2.urp2
5 files changed, 33 insertions, 3 deletions
diff --git a/src/tag.sml b/src/tag.sml
index 30720ec9..582a3b8e 100644
--- a/src/tag.sml
+++ b/src/tag.sml
@@ -41,6 +41,10 @@ structure SM = BinaryMapFn(struct
fun kind (k, s) = (k, s)
fun con (c, s) = (c, s)
+fun both (loc, f) = (ErrorMsg.errorAt loc ("Function " ^ f ^ " needed for both a link and a form");
+ TextIO.output (TextIO.stdErr,
+ "Make sure that the signature of the containing module hides any form handlers.\n"))
+
fun exp env (e, s) =
case e of
EApp (
@@ -105,8 +109,7 @@ fun exp env (e, s) =
if ek = ek' then
()
else
- ErrorMsg.errorAt loc
- "Function needed as both a link and a form ";
+ both (loc, s);
byTag)
val e = (EClosure (cn, args), loc)
@@ -166,7 +169,7 @@ fun tag file =
(if ek = ek' then
()
else
- ErrorMsg.errorAt loc "Function needed for both a link and a form";
+ both (loc, s);
([], (env, count, tags, byTag)))
end
| _ =>
diff --git a/tests/both.ur b/tests/both.ur
new file mode 100644
index 00000000..d1c9f40e
--- /dev/null
+++ b/tests/both.ur
@@ -0,0 +1,9 @@
+fun main () : transaction page = return <xml>
+ <body>
+ <form>
+ <textbox{#Text}/><submit action={submit}/>
+ </form>
+ </body>
+</xml>
+
+and submit r = return <xml/>
diff --git a/tests/both.urp b/tests/both.urp
new file mode 100644
index 00000000..a29c8ea1
--- /dev/null
+++ b/tests/both.urp
@@ -0,0 +1,2 @@
+
+both
diff --git a/tests/both2.ur b/tests/both2.ur
new file mode 100644
index 00000000..c3f25cc9
--- /dev/null
+++ b/tests/both2.ur
@@ -0,0 +1,14 @@
+fun main () : transaction page =
+ let
+ fun submit r = return <xml/>
+ in
+ return <xml>
+ <body>
+ <form>
+ <textbox{#Text}/><submit action={submit}/>
+ </form>
+ </body>
+ </xml>
+ end
+
+
diff --git a/tests/both2.urp b/tests/both2.urp
new file mode 100644
index 00000000..8e85a838
--- /dev/null
+++ b/tests/both2.urp
@@ -0,0 +1,2 @@
+
+both2