diff options
| -rw-r--r-- | src/urweb.lex | 55 | ||||
| -rw-r--r-- | tests/ent.ur | 3 | ||||
| -rw-r--r-- | tests/ent.urp | 3 | ||||
| -rw-r--r-- | tests/ent.urs | 1 |
4 files changed, 60 insertions, 2 deletions
diff --git a/src/urweb.lex b/src/urweb.lex index 85cf3bcf..46835fa2 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -1,4 +1,6 @@ -(* Copyright (c) 2008, Adam Chlipala +(* -*- mode: sml-lex -*- *) + +(* Copyright (c) 2008-2009, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -106,6 +108,55 @@ fun initialize () = (xmlTag := []; xmlString := false) +fun unescape loc s = + let + fun process (s, acc) = + let + val (befor, after) = Substring.splitl (fn ch => ch <> #"&") s + in + if Substring.size after = 0 then + Substring.concat (rev (s :: acc)) + else + let + val after = Substring.slice (after, 1, NONE) + val (befor', after') = Substring.splitl (fn ch => ch <> #";") after + in + if Substring.size after' = 0 then + (ErrorMsg.errorAt' loc "Missing ';' after '&'"; + "") + else + let + val pre = befor + val code = befor' + val s = Substring.slice (after', 1, NONE) + + val special = + if Substring.size code > 0 andalso Substring.sub (code, 0) = #"#" + andalso CharVectorSlice.all Char.isDigit (Substring.slice (code, 1, NONE)) then + let + val code = Substring.string (Substring.slice (code, 1, NONE)) + in + Option.map chr (Int.fromString code) + end + else case Substring.string code of + "amp" => SOME #"&" + | "lt" => SOME #"<" + | "gt" => SOME #">" + | "quot" => SOME #"\"" + | _ => NONE + in + case special of + NONE => (ErrorMsg.errorAt' loc ("Unsupported XML character entity " + ^ Substring.string code); + "") + | SOME ch => process (s, Substring.full (String.str ch) :: pre :: acc) + end + end + end + in + process (Substring.full s, []) + end + %% %header (functor UrwebLexFn(structure Tokens : Urweb_TOKENS)); %full @@ -231,7 +282,7 @@ notags = [^<{\n]+; pushLevel (fn () => YYBEGIN XML); Tokens.LBRACE (yypos, yypos + 1)); -<XML> {notags} => (Tokens.NOTAGS (yytext, yypos, yypos + size yytext)); +<XML> {notags} => (Tokens.NOTAGS (unescape (yypos, yypos + size yytext) yytext, yypos, yypos + size yytext)); <XML> . => (ErrorMsg.errorAt' (yypos, yypos) ("illegal XML character: \"" ^ yytext ^ "\""); diff --git a/tests/ent.ur b/tests/ent.ur new file mode 100644 index 00000000..fa01e8cf --- /dev/null +++ b/tests/ent.ur @@ -0,0 +1,3 @@ +fun main () = return <xml><body> + <Whoa-hoa!> ABCD! +</body></xml> diff --git a/tests/ent.urp b/tests/ent.urp new file mode 100644 index 00000000..f63d1159 --- /dev/null +++ b/tests/ent.urp @@ -0,0 +1,3 @@ +debug + +ent diff --git a/tests/ent.urs b/tests/ent.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/ent.urs @@ -0,0 +1 @@ +val main : unit -> transaction page |