summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/monoize.sml32
-rw-r--r--tests/prefixClash.ur3
-rw-r--r--tests/prefixClash.urp4
-rw-r--r--tests/prefixClash.urs3
4 files changed, 42 insertions, 0 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index 48001a13..97ad1505 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -50,6 +50,36 @@ structure RM = BinaryMapFn(struct
(L'.TRecord r2, E.dummySpan))
end)
+local
+ val url_prefixes = ref []
+in
+
+fun reset () = url_prefixes := []
+
+fun addPrefix prefix =
+ let
+ fun isPrefix s1 s2 =
+ String.isPrefix s1 s2
+ andalso (size s1 = size s2
+ orelse String.sub (s2, size s1) = #"/")
+ in
+ if List.exists (fn prefix' =>
+ let
+ fun tryOne prefix' prefix =
+ isPrefix prefix' prefix
+ andalso (ErrorMsg.error ("Conflicting URL prefixes for page handlers: \"" ^ prefix' ^ "\" is a prefix of \"" ^ prefix ^ "\".");
+ true)
+ in
+ tryOne prefix' prefix
+ orelse tryOne prefix prefix'
+ end) (!url_prefixes) then
+ ()
+ else
+ url_prefixes := prefix :: !url_prefixes
+ end
+
+end
+
val nextPvar = MonoFooify.nextPvar
val pvars = ref (RM.empty : (int * (string * int * L'.typ) list) RM.map)
val pvarDefs = MonoFooify.pvarDefs
@@ -4233,6 +4263,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
| L.DExport (ek, n, b) =>
let
val (_, t, _, s) = Env.lookupENamed env n
+ val () = addPrefix s
fun unwind (t, args) =
case #1 t of
@@ -4392,6 +4423,7 @@ datatype expungable = Client | Channel
fun monoize env file =
let
+ val () = reset ()
val () = pvars := RM.empty
(* Calculate which exported functions need cookie signature protection *)
diff --git a/tests/prefixClash.ur b/tests/prefixClash.ur
new file mode 100644
index 00000000..a2325077
--- /dev/null
+++ b/tests/prefixClash.ur
@@ -0,0 +1,3 @@
+val index = return <xml></xml>
+val other = return <xml></xml>
+val ather = return <xml></xml>
diff --git a/tests/prefixClash.urp b/tests/prefixClash.urp
new file mode 100644
index 00000000..cf4545d0
--- /dev/null
+++ b/tests/prefixClash.urp
@@ -0,0 +1,4 @@
+rewrite url PrefixClash/index foo
+rewrite url PrefixClash/* foo/ [-]
+
+prefixClash
diff --git a/tests/prefixClash.urs b/tests/prefixClash.urs
new file mode 100644
index 00000000..e5e58c0a
--- /dev/null
+++ b/tests/prefixClash.urs
@@ -0,0 +1,3 @@
+val index : transaction page
+val other : transaction page
+val ather : transaction page