100%

lib/encoding/decode.ml

···
       match Prescan.prescan_for_meta_charset data with
       | Some enc -> (decode_with_encoding data enc ~bom_len:0, enc)
       | None ->
-        (* Default to UTF-8 *)
-        (decode_with_encoding data Encoding.Utf8 ~bom_len:0, Encoding.Utf8)
+        (* Default to Windows-1252 per HTML5 spec when no encoding detected *)
+        (decode_with_encoding data Encoding.Windows_1252 ~bom_len:0, Encoding.Windows_1252)

lib/encoding/prescan.ml

···
         if !j + 2 < len then
           i := !j + 3
         else
-          result := None  (* Unclosed comment, stop scanning *)
+          i := len  (* Unclosed comment - stop scanning *)
       end
       (* Check for end tag - skip it *)
       else if !i + 1 < len && Bytes.get data (!i + 1) = '/' then begin
         let j = ref (!i + 2) in
         let in_quote = ref None in
-        while !j < len && !j < max_total && !non_comment < max_non_comment do
+        let done_tag = ref false in
+        while not !done_tag && !j < len && !j < max_total && !non_comment < max_non_comment do
           let c = Bytes.get data !j in
           match !in_quote with
           | None ->
···
             end else if c = '>' then begin
               incr j;
               incr non_comment;
-              j := len  (* Exit loop *)
+              done_tag := true
             end else begin
               incr j;
               incr non_comment
···
         if tag_name <> "meta" then begin
           (* Skip non-meta tag *)
           let in_quote = ref None in
-          while !j < len && !j < max_total && !non_comment < max_non_comment do
+          let done_tag = ref false in
+          while not !done_tag && !j < len && !j < max_total && !non_comment < max_non_comment do
             let c = Bytes.get data !j in
             match !in_quote with
             | None ->
···
               end else if c = '>' then begin
                 incr j;
                 incr non_comment;
-                j := len
+                done_tag := true
               end else begin
                 incr j;
                 incr non_comment
···
             | None -> ());
 
             (* Check for http-equiv="content-type" with content *)
+            (* Note: http-equiv value must be exactly "content-type" (case-insensitive) *)
             if !result = None then
               (match !http_equiv, !content with
               | Some he, Some ct when String.lowercase_ascii he = "content-type" ->

lib/tokenizer/stream.ml

···
   mutable last_was_cr : bool;
   (* Track if we need to skip the next LF from raw stream (set after peek of CR) *)
   mutable skip_next_lf : bool;
+  (* Error callback for surrogate/noncharacter detection *)
+  mutable error_callback : (string -> unit) option;
 }
 
 (* Create a stream from a Bytes.Reader.t *)
···
     column = 0;
     last_was_cr = false;
     skip_next_lf = false;
+    error_callback = None;
   }
 
+let set_error_callback t cb =
+  t.error_callback <- Some cb
+
+(* Check if a Unicode codepoint is a surrogate *)
+let is_surrogate cp = cp >= 0xD800 && cp <= 0xDFFF
+
+(* Check if a Unicode codepoint is a noncharacter *)
+let is_noncharacter cp =
+  (* U+FDD0 to U+FDEF *)
+  (cp >= 0xFDD0 && cp <= 0xFDEF) ||
+  (* U+FFFE and U+FFFF in each plane (0-16) *)
+  ((cp land 0xFFFF) = 0xFFFE || (cp land 0xFFFF) = 0xFFFF)
+
 (* Create a stream from a string - discouraged, prefer create_from_reader *)
 let create input =
   create_from_reader (Bytes.Reader.of_string input)
···
 let push_back_char t c =
   t.lookahead <- c :: t.lookahead
 
+(* Check for surrogates and noncharacters in UTF-8 sequences.
+   Called after reading a lead byte, peeks continuation bytes to decode codepoint. *)
+let check_utf8_codepoint t lead_byte =
+  let b0 = Char.code lead_byte in
+  if b0 < 0x80 then
+    (* ASCII - no surrogates or noncharacters possible in this range except control chars *)
+    ()
+  else if b0 >= 0xC2 && b0 <= 0xDF then begin
+    (* 2-byte sequence: 110xxxxx 10xxxxxx -> U+0080 to U+07FF *)
+    (* Check for C1 control characters U+0080-U+009F *)
+    match read_raw_char t with
+    | Some c1 when (Char.code c1 land 0xC0) = 0x80 ->
+      let b1 = Char.code c1 in
+      let cp = ((b0 land 0x1F) lsl 6) lor (b1 land 0x3F) in
+      push_back_char t c1;
+      (* C1 controls: U+0080 to U+009F *)
+      if cp >= 0x80 && cp <= 0x9F then
+        (match t.error_callback with
+        | Some cb -> cb "control-character-in-input-stream"
+        | None -> ())
+    | Some c1 ->
+      push_back_char t c1
+    | None -> ()
+  end else if b0 >= 0xE0 && b0 <= 0xEF then begin
+    (* 3-byte sequence: 1110xxxx 10xxxxxx 10xxxxxx -> U+0800 to U+FFFF *)
+    (* Need to peek 2 continuation bytes *)
+    match read_raw_char t with
+    | Some c1 when (Char.code c1 land 0xC0) = 0x80 ->
+      let b1 = Char.code c1 in
+      (match read_raw_char t with
+      | Some c2 when (Char.code c2 land 0xC0) = 0x80 ->
+        let b2 = Char.code c2 in
+        let cp = ((b0 land 0x0F) lsl 12) lor ((b1 land 0x3F) lsl 6) lor (b2 land 0x3F) in
+        push_back_char t c2;
+        push_back_char t c1;
+        (* Check for surrogates and noncharacters *)
+        (match t.error_callback with
+        | Some cb ->
+          if is_surrogate cp then cb "surrogate-in-input-stream"
+          else if is_noncharacter cp then cb "noncharacter-in-input-stream"
+        | None -> ())
+      | Some c2 ->
+        push_back_char t c2;
+        push_back_char t c1
+      | None ->
+        push_back_char t c1)
+    | Some c1 ->
+      push_back_char t c1
+    | None -> ()
+  end else if b0 >= 0xF0 && b0 <= 0xF4 then begin
+    (* 4-byte sequence: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx -> U+10000 to U+10FFFF *)
+    match read_raw_char t with
+    | Some c1 when (Char.code c1 land 0xC0) = 0x80 ->
+      let b1 = Char.code c1 in
+      (match read_raw_char t with
+      | Some c2 when (Char.code c2 land 0xC0) = 0x80 ->
+        let b2 = Char.code c2 in
+        (match read_raw_char t with
+        | Some c3 when (Char.code c3 land 0xC0) = 0x80 ->
+          let b3 = Char.code c3 in
+          let cp = ((b0 land 0x07) lsl 18) lor ((b1 land 0x3F) lsl 12) lor
+                   ((b2 land 0x3F) lsl 6) lor (b3 land 0x3F) in
+          push_back_char t c3;
+          push_back_char t c2;
+          push_back_char t c1;
+          (* Check for noncharacters (no surrogates in 4-byte range) *)
+          (match t.error_callback with
+          | Some cb ->
+            if is_noncharacter cp then cb "noncharacter-in-input-stream"
+          | None -> ())
+        | Some c3 ->
+          push_back_char t c3;
+          push_back_char t c2;
+          push_back_char t c1
+        | None ->
+          push_back_char t c2;
+          push_back_char t c1)
+      | Some c2 ->
+        push_back_char t c2;
+        push_back_char t c1
+      | None ->
+        push_back_char t c1)
+    | Some c1 ->
+      push_back_char t c1
+    | None -> ()
+  end
+
 (* Read next char with CR/LF normalization *)
 let rec read_normalized_char t =
+  (* Track if we're reading from lookahead - if so, we've already checked this byte *)
+  let from_lookahead = t.lookahead <> [] in
   match read_raw_char t with
   | None ->
     t.last_was_cr <- false;
···
     read_normalized_char t
   | Some c ->
     t.last_was_cr <- false;
+    (* Only check for surrogates/noncharacters when reading fresh from stream,
+       not when re-reading from lookahead (to avoid duplicate errors) *)
+    if not from_lookahead then check_utf8_codepoint t c;
     Some c
 
 let is_eof t =

lib/tokenizer/tokenizer.ml

···
   mutable pending_chars : Buffer.t;
   mutable errors : Errors.t list;
   collect_errors : bool;
+  xml_mode : bool;  (* XML violation mode: transform chars for XML compatibility *)
 }
 
-let create (type s) (module S : SINK with type t = s) sink ?(collect_errors=false) () = {
+let create (type s) (module S : SINK with type t = s) sink ?(collect_errors=false) ?(xml_mode=false) () = {
   stream = Stream.create "";
   sink;
   state = State.Data;
···
   pending_chars = Buffer.create 256;
   errors = [];
   collect_errors;
+  xml_mode;
 }
 
 let error t code =
···
 
 (* emit functions are defined locally inside run *)
 
+(* XML mode character transformation: form feed → space *)
 let emit_char t c =
-  Buffer.add_char t.pending_chars c
+  if t.xml_mode && c = '\x0C' then
+    Buffer.add_char t.pending_chars ' '
+  else
+    Buffer.add_char t.pending_chars c
 
+(* XML mode string transformation: U+FFFF → U+FFFD, form feed → space *)
 let emit_str t s =
-  Buffer.add_string t.pending_chars s
+  if t.xml_mode then begin
+    (* Transform: \xEF\xBF\xBF (U+FFFF) → \xEF\xBF\xBD (U+FFFD), \x0C → space *)
+    let len = String.length s in
+    let i = ref 0 in
+    while !i < len do
+      let c = s.[!i] in
+      if c = '\x0C' then begin
+        Buffer.add_char t.pending_chars ' ';
+        incr i
+      end else if c = '\xEF' && !i + 2 < len && s.[!i+1] = '\xBF' && s.[!i+2] = '\xBF' then begin
+        (* U+FFFF → U+FFFD *)
+        Buffer.add_string t.pending_chars "\xEF\xBF\xBD";
+        i := !i + 3
+      end else begin
+        Buffer.add_char t.pending_chars c;
+        incr i
+      end
+    done
+  end else
+    Buffer.add_string t.pending_chars s
 
 let start_new_tag t kind =
   Buffer.clear t.current_tag_name;
···
 let run (type s) t (module S : SINK with type t = s) (reader : Bytes.Reader.t) =
   t.stream <- Stream.create_from_reader reader;
   t.errors <- [];
+  (* Set up error callback for surrogate/noncharacter detection in stream *)
+  (* In XML mode, we don't report noncharacter errors - we transform them instead *)
+  if not t.xml_mode then
+    Stream.set_error_callback t.stream (fun code -> error t code);
+
+  (* XML mode transformation for pending chars: U+FFFF → U+FFFD *)
+  let transform_xml_chars data =
+    let len = String.length data in
+    let buf = Buffer.create len in
+    let i = ref 0 in
+    while !i < len do
+      let c = data.[!i] in
+      if c = '\xEF' && !i + 2 < len && data.[!i+1] = '\xBF' && data.[!i+2] = '\xBF' then begin
+        (* U+FFFF → U+FFFD *)
+        Buffer.add_string buf "\xEF\xBF\xBD";
+        i := !i + 3
+      end else begin
+        Buffer.add_char buf c;
+        incr i
+      end
+    done;
+    Buffer.contents buf
+  in
 
   (* Local emit functions with access to S *)
   let emit_pending_chars () =
     if Buffer.length t.pending_chars > 0 then begin
       let data = Buffer.contents t.pending_chars in
       Buffer.clear t.pending_chars;
+      let data = if t.xml_mode then transform_xml_chars data else data in
       ignore (S.process t.sink (Token.Character data))
     end
   in
···
   in
 
   let emit_current_comment () =
-    emit (Token.Comment (Buffer.contents t.current_comment))
+    let content = Buffer.contents t.current_comment in
+    let content =
+      if t.xml_mode then begin
+        (* XML mode: transform -- to - - in comments *)
+        let buf = Buffer.create (String.length content + 10) in
+        let len = String.length content in
+        let i = ref 0 in
+        while !i < len do
+          if !i + 1 < len && content.[!i] = '-' && content.[!i+1] = '-' then begin
+            Buffer.add_string buf "- -";
+            i := !i + 2
+          end else begin
+            Buffer.add_char buf content.[!i];
+            incr i
+          end
+        done;
+        Buffer.contents buf
+      end else content
+    in
+    emit (Token.Comment content)
   in
 
   (* Check for control characters and emit error if needed *)
+  (* Only checks ASCII control chars; C1 controls (U+0080-U+009F) are 2-byte in UTF-8 *)
   let check_control_char c =
     let code = Char.code c in
-    (* Control chars: U+0001-U+0008, U+000B, U+000E-U+001F, U+007F-U+009F *)
+    (* Control chars: U+0001-U+0008, U+000B, U+000E-U+001F, U+007F *)
     (* Allowed: U+0009 (tab), U+000A (LF), U+000C (FF), U+000D (CR) *)
+    (* Note: U+0080-U+009F (C1 controls) are 2-byte UTF-8 sequences starting with 0xC2 *)
+    (* Note: We only check single-byte control chars here; multi-byte checks are TODO *)
     if (code >= 0x01 && code <= 0x08) ||
        code = 0x0B ||
        (code >= 0x0E && code <= 0x1F) ||
-       (code >= 0x7F && code <= 0x9F) then
+       code = 0x7F then
       error t "control-character-in-input-stream"
   in
+
 
   (* Emit char with control character check *)
   let emit_char_checked c =
···
     | State.Script_data_escaped
     | State.Script_data_escaped_dash
     | State.Script_data_escaped_dash_dash ->
+      error t "eof-in-script-html-comment-like-text";
       emit_pending_chars ();
       ignore (S.process t.sink Token.EOF)
     | State.Script_data_escaped_less_than_sign ->
···
     | State.Script_data_double_escaped
     | State.Script_data_double_escaped_dash
     | State.Script_data_double_escaped_dash_dash ->
+      error t "eof-in-script-html-comment-like-text";
       emit_pending_chars ();
       ignore (S.process t.sink Token.EOF)
     | State.Script_data_double_escaped_less_than_sign ->
···
       error t "unexpected-null-character";
       Buffer.add_string t.current_tag_name "\xEF\xBF\xBD"
     | Some c ->
+      check_control_char c;
       Buffer.add_char t.current_tag_name (ascii_lower c)
     | None -> ()
 
···
       Buffer.add_char t.current_attr_name (Option.get c_opt)
     | Some c ->
       Stream.advance t.stream;
+      check_control_char c;
       Buffer.add_char t.current_attr_name (ascii_lower c)
 
   and state_after_attribute_name () =
···
       error t "unexpected-null-character";
       Buffer.add_string t.current_attr_value "\xEF\xBF\xBD"
     | Some c ->
+      check_control_char c;
       Buffer.add_char t.current_attr_value c
     | None -> ()
 
···
       error t "unexpected-null-character";
       Buffer.add_string t.current_attr_value "\xEF\xBF\xBD"
     | Some c ->
+      check_control_char c;
       Buffer.add_char t.current_attr_value c
     | None -> ()
 
···
       Buffer.add_char t.current_attr_value (Option.get c_opt)
     | Some c ->
       Stream.advance t.stream;
+      check_control_char c;
       Buffer.add_char t.current_attr_value c
     | None -> ()
 
···
       error t "unexpected-null-character";
       Buffer.add_string t.current_comment "\xEF\xBF\xBD"
     | Some c ->
+      check_control_char c;
       Buffer.add_char t.current_comment c
     | None -> ()
 
···
       error t "unexpected-null-character";
       Buffer.add_string t.current_comment "\xEF\xBF\xBD"
     | Some c ->
+      check_control_char c;
       Buffer.add_char t.current_comment c
     | None -> ()
 
···
     | None -> ()
     | Some c ->
       Stream.advance t.stream;
+      check_control_char c;
       start_new_doctype t;
       t.current_doctype_name <- Some (Buffer.create 8);
       Buffer.add_char (Option.get t.current_doctype_name) (ascii_lower c);
···
       error t "unexpected-null-character";
       Buffer.add_string (Option.get t.current_doctype_name) "\xEF\xBF\xBD"
     | Some c ->
+      check_control_char c;
       Buffer.add_char (Option.get t.current_doctype_name) (ascii_lower c)
     | None -> ()
 
···
       emit_current_doctype ()
     | None -> ()
     | Some _ ->
+      (* Don't check control char here - bogus_doctype will check when it consumes *)
       if Stream.matches_ci t.stream "PUBLIC" then begin
         ignore (Stream.consume_exact_ci t.stream "PUBLIC");
         t.state <- State.After_doctype_public_keyword
···
       emit_current_doctype ()
     | None -> ()
     | Some _ ->
+      (* Don't check control char here - bogus_doctype will check when it consumes *)
       error t "missing-quote-before-doctype-public-identifier";
       t.current_doctype_force_quirks <- true;
       t.state <- State.Bogus_doctype
···
       t.state <- State.Data;
       emit_current_doctype ()
     | Some c ->
+      check_control_char c;
       Buffer.add_char (Option.get t.current_doctype_public) c
     | None -> ()
 
···
       t.state <- State.Data;
       emit_current_doctype ()
     | Some c ->
+      check_control_char c;
       Buffer.add_char (Option.get t.current_doctype_public) c
     | None -> ()
 
···
       t.state <- State.Doctype_system_identifier_single_quoted
     | None -> ()
     | Some _ ->
+      (* Don't check control char here - bogus_doctype will check when it consumes *)
       error t "missing-quote-before-doctype-system-identifier";
       t.current_doctype_force_quirks <- true;
       t.state <- State.Bogus_doctype
···
       t.state <- State.Doctype_system_identifier_single_quoted
     | None -> ()
     | Some _ ->
+      (* Don't check control char here - bogus_doctype will check when it consumes *)
       error t "missing-quote-before-doctype-system-identifier";
       t.current_doctype_force_quirks <- true;
       t.state <- State.Bogus_doctype
···
       emit_current_doctype ()
     | None -> ()
     | Some _ ->
+      (* Don't check control char here - bogus_doctype will check when it consumes *)
       error t "missing-quote-before-doctype-system-identifier";
       t.current_doctype_force_quirks <- true;
       t.state <- State.Bogus_doctype
···
       emit_current_doctype ()
     | None -> ()
     | Some _ ->
+      (* Don't check control char here - bogus_doctype will check when it consumes *)
       error t "missing-quote-before-doctype-system-identifier";
       t.current_doctype_force_quirks <- true;
       t.state <- State.Bogus_doctype
···
       t.state <- State.Data;
       emit_current_doctype ()
     | Some c ->
+      check_control_char c;
       Buffer.add_char (Option.get t.current_doctype_system) c
     | None -> ()
 
···
       t.state <- State.Data;
       emit_current_doctype ()
     | Some c ->
+      check_control_char c;
       Buffer.add_char (Option.get t.current_doctype_system) c
     | None -> ()
 
···
       emit_current_doctype ()
     | None -> ()
     | Some _ ->
+      (* Don't check control char here - bogus_doctype will check when it consumes *)
       error t "unexpected-character-after-doctype-system-identifier";
       t.state <- State.Bogus_doctype
 
···
       emit_current_doctype ()
     | Some '\x00' ->
       error t "unexpected-null-character"
-    | Some _ -> ()
+    | Some c ->
+      check_control_char c  (* Check all chars in bogus doctype *)
     | None -> ()
 
   and state_cdata_section () =
···
     | Some ']' ->
       t.state <- State.Cdata_section_bracket
     | Some c ->
-      (* CDATA section emits all characters as-is, including NUL *)
-      emit_char t c
+      (* CDATA section emits all characters as-is, including NUL, but still check for control chars *)
+      emit_char_checked c
     | None -> ()
 
   and state_cdata_section_bracket () =

test/test_serializer.ml

···
   | Jsont.String (s, _) -> Some s
   | _ -> failwith "Expected string or null"
 
+let json_bool = function
+  | Jsont.Bool (b, _) -> b
+  | _ -> failwith "Expected bool"
+
 let json_array = function
   | Jsont.Array (arr, _) -> arr
   | _ -> failwith "Expected array"
···
   | Some v -> v
   | None -> failwith ("Missing member: " ^ name)
 
+(* Serialization options *)
+type serialize_options = {
+  quote_char : char;
+  quote_char_explicit : bool;  (* Was quote_char explicitly set? *)
+  minimize_boolean_attributes : bool;
+  use_trailing_solidus : bool;
+  escape_lt_in_attrs : bool;
+  escape_rcdata : bool;
+  strip_whitespace : bool;
+  inject_meta_charset : bool;
+  encoding : string option;
+  omit_optional_tags : bool;
+}
+
+let default_options = {
+  quote_char = '"';
+  quote_char_explicit = false;
+  minimize_boolean_attributes = true;
+  use_trailing_solidus = false;
+  escape_lt_in_attrs = false;
+  escape_rcdata = false;
+  strip_whitespace = false;
+  inject_meta_charset = false;
+  encoding = None;
+  omit_optional_tags = true;  (* HTML5 default *)
+}
+
+(* Parse options from JSON *)
+let parse_options json_opt =
+  match json_opt with
+  | None -> default_options
+  | Some json ->
+    let obj = json_object json in
+    let get_bool name default =
+      match json_mem name obj with
+      | Some j -> (try json_bool j with _ -> default)
+      | None -> default
+    in
+    let get_string name =
+      match json_mem name obj with
+      | Some (Jsont.String (s, _)) -> Some s
+      | _ -> None
+    in
+    let quote_char_opt =
+      match json_mem "quote_char" obj with
+      | Some (Jsont.String (s, _)) when String.length s = 1 -> Some s.[0]
+      | _ -> None
+    in
+    {
+      quote_char = Option.value ~default:'"' quote_char_opt;
+      quote_char_explicit = Option.is_some quote_char_opt;
+      minimize_boolean_attributes = get_bool "minimize_boolean_attributes" (get_bool "quote_attr_values" true);
+      use_trailing_solidus = get_bool "use_trailing_solidus" false;
+      escape_lt_in_attrs = get_bool "escape_lt_in_attrs" false;
+      escape_rcdata = get_bool "escape_rcdata" false;
+      strip_whitespace = get_bool "strip_whitespace" false;
+      inject_meta_charset = get_bool "inject_meta_charset" false;
+      encoding = get_string "encoding";
+      omit_optional_tags = get_bool "omit_optional_tags" true;
+    }
+
 (* Test case *)
 type test_case = {
   description : string;
   input : Jsont.json list;
   expected : string list;
+  options : serialize_options;
 }
 
 let parse_test_case json =
···
   let description = json_string (json_mem_exn "description" obj) in
   let input = json_array (json_mem_exn "input" obj) in
   let expected = List.map json_string (json_array (json_mem_exn "expected" obj)) in
-  { description; input; expected }
+  let options = parse_options (json_mem "options" obj) in
+  { description; input; expected; options }
+
+(* Parse attrs that can be either array [{name, value}] or object {name: value} or empty {} *)
+let parse_attrs attrs_json =
+  match attrs_json with
+  | Jsont.Array (arr, _) ->
+    List.map (fun attr_json ->
+      let attr_obj = json_object attr_json in
+      let attr_name = json_string (json_mem_exn "name" attr_obj) in
+      let value = json_string (json_mem_exn "value" attr_obj) in
+      (attr_name, value)
+    ) arr
+  | Jsont.Object (obj, _) ->
+    List.map (fun ((n, _), v) -> (n, json_string v)) obj
+  | _ -> []
 
-(* Build a DOM node from test input token *)
-let build_node_from_token token =
+(* Void elements that don't need end tags *)
+let is_void_element name =
+  List.mem (String.lowercase_ascii name)
+    ["area"; "base"; "br"; "col"; "embed"; "hr"; "img"; "input";
+     "link"; "meta"; "param"; "source"; "track"; "wbr"]
+
+(* Raw text elements whose content should not be escaped *)
+let is_raw_text_element name =
+  List.mem (String.lowercase_ascii name) ["script"; "style"]
+
+(* Elements where whitespace should be preserved *)
+let is_whitespace_preserving_element name =
+  List.mem (String.lowercase_ascii name) ["pre"; "textarea"; "script"; "style"]
+
+(* Block elements that close a p tag *)
+let p_closing_elements = [
+  "address"; "article"; "aside"; "blockquote"; "datagrid"; "dialog"; "dir";
+  "div"; "dl"; "fieldset"; "footer"; "form"; "h1"; "h2"; "h3"; "h4"; "h5"; "h6";
+  "header"; "hgroup"; "hr"; "main"; "menu"; "nav"; "ol"; "p"; "pre"; "section";
+  "table"; "ul"
+]
+
+let is_p_closing_element name =
+  List.mem (String.lowercase_ascii name) p_closing_elements
+
+(* Collapse runs of whitespace to single space *)
+let collapse_whitespace text =
+  let len = String.length text in
+  let buf = Buffer.create len in
+  let in_whitespace = ref false in
+  for i = 0 to len - 1 do
+    let c = text.[i] in
+    if c = '\t' || c = '\r' || c = '\n' || c = '\x0C' || c = ' ' then begin
+      if not !in_whitespace then begin
+        Buffer.add_char buf ' ';
+        in_whitespace := true
+      end
+    end else begin
+      Buffer.add_char buf c;
+      in_whitespace := false
+    end
+  done;
+  Buffer.contents buf
+
+(* Token types for stream-based serialization *)
+type token_type =
+  | StartTag of string * (string * string) list  (* name, attrs *)
+  | EndTag of string  (* name *)
+  | EmptyTag of string * (string * string) list  (* name, attrs *)
+  | TextNode of string
+  | CommentNode of string
+  | DoctypeNode of Dom.node
+
+type token_info = {
+  token : token_type option;
+  node : Dom.node option;  (* Legacy for compatibility *)
+  tag_name : string option;
+  is_empty_tag : bool;
+}
+
+let build_token_info token =
   let arr = json_array token in
   match arr with
-  | [] -> None
+  | [] -> { token = None; node = None; tag_name = None; is_empty_tag = false }
   | type_json :: rest ->
-    let token_type = json_string type_json in
-    match token_type, rest with
+    let token_type_str = json_string type_json in
+    match token_type_str, rest with
     | "StartTag", [_ns_json; name_json; attrs_json] ->
       let name = json_string name_json in
-      let attrs_list = json_array attrs_json in
-      let attrs = List.map (fun attr_json ->
-        let attr_obj = json_object attr_json in
-        let attr_name = json_string (json_mem_exn "name" attr_obj) in
-        let value = json_string (json_mem_exn "value" attr_obj) in
-        (attr_name, value)
-      ) attrs_list in
-      Some (Dom.create_element name ~attrs ())
+      let attrs = parse_attrs attrs_json in
+      { token = Some (StartTag (name, attrs));
+        node = Some (Dom.create_element name ~attrs ());
+        tag_name = Some name;
+        is_empty_tag = false }
 
     | "StartTag", [name_json; attrs_json] ->
       let name = json_string name_json in
-      let attrs_obj = json_object attrs_json in
-      let attrs = List.map (fun ((n, _), v) -> (n, json_string v)) attrs_obj in
-      Some (Dom.create_element name ~attrs ())
+      let attrs = parse_attrs attrs_json in
+      { token = Some (StartTag (name, attrs));
+        node = Some (Dom.create_element name ~attrs ());
+        tag_name = Some name;
+        is_empty_tag = false }
 
     | "EmptyTag", [name_json; attrs_json] ->
       let name = json_string name_json in
-      let attrs_obj = json_object attrs_json in
-      let attrs = List.map (fun ((n, _), v) -> (n, json_string v)) attrs_obj in
-      Some (Dom.create_element name ~attrs ())
+      let attrs = parse_attrs attrs_json in
+      { token = Some (EmptyTag (name, attrs));
+        node = Some (Dom.create_element name ~attrs ());
+        tag_name = Some name;
+        is_empty_tag = true }
+
+    | "EndTag", [_ns_json; name_json] ->
+      let name = json_string name_json in
+      { token = Some (EndTag name);
+        node = None;
+        tag_name = Some name;
+        is_empty_tag = false }
+
+    | "EndTag", [name_json] ->
+      let name = json_string name_json in
+      { token = Some (EndTag name);
+        node = None;
+        tag_name = Some name;
+        is_empty_tag = false }
 
     | "Characters", [text_json] ->
       let text = json_string text_json in
-      Some (Dom.create_text text)
+      { token = Some (TextNode text);
+        node = Some (Dom.create_text text);
+        tag_name = None;
+        is_empty_tag = false }
 
     | "Comment", [text_json] ->
       let text = json_string text_json in
-      Some (Dom.create_comment text)
+      { token = Some (CommentNode text);
+        node = Some (Dom.create_comment text);
+        tag_name = None;
+        is_empty_tag = false }
 
     | "Doctype", [name_json] ->
       let name = json_string name_json in
-      Some (Dom.create_doctype ~name ())
+      let node = Dom.create_doctype ~name () in
+      { token = Some (DoctypeNode node);
+        node = Some node;
+        tag_name = None;
+        is_empty_tag = false }
 
     | "Doctype", [name_json; public_json] ->
       let name = json_string name_json in
       let public_id = json_string_opt public_json in
-      (match public_id with
-       | Some pub -> Some (Dom.create_doctype ~name ~public_id:pub ())
-       | None -> Some (Dom.create_doctype ~name ()))
+      let node = match public_id with
+       | Some pub -> Dom.create_doctype ~name ~public_id:pub ()
+       | None -> Dom.create_doctype ~name ()
+      in
+      { token = Some (DoctypeNode node);
+        node = Some node;
+        tag_name = None;
+        is_empty_tag = false }
 
     | "Doctype", [name_json; public_json; system_json] ->
       let name = json_string name_json in
       let public_id = json_string_opt public_json in
       let system_id = json_string_opt system_json in
-      (match public_id, system_id with
-       | Some pub, Some sys -> Some (Dom.create_doctype ~name ~public_id:pub ~system_id:sys ())
-       | Some pub, None -> Some (Dom.create_doctype ~name ~public_id:pub ())
-       | None, Some sys -> Some (Dom.create_doctype ~name ~system_id:sys ())
-       | None, None -> Some (Dom.create_doctype ~name ()))
+      let node = match public_id, system_id with
+       | Some pub, Some sys -> Dom.create_doctype ~name ~public_id:pub ~system_id:sys ()
+       | Some pub, None -> Dom.create_doctype ~name ~public_id:pub ()
+       | None, Some sys -> Dom.create_doctype ~name ~system_id:sys ()
+       | None, None -> Dom.create_doctype ~name ()
+      in
+      { token = Some (DoctypeNode node);
+        node = Some node;
+        tag_name = None;
+        is_empty_tag = false }
 
-    | _ -> None
+    | _ -> { token = None; node = None; tag_name = None; is_empty_tag = false }
 
-(* Serialize a single node to HTML (simplified, matches test expectations) *)
+(* Serialize a single node to HTML with options *)
 let escape_text text =
   let buf = Buffer.create (String.length text) in
   String.iter (fun c ->
···
     ) value;
     !valid
 
-let choose_quote value =
-  if String.contains value '"' && not (String.contains value '\'') then '\''
-  else '"'
-
-let escape_attr_value value quote_char =
+let escape_attr_value value quote_char escape_lt =
   let buf = Buffer.create (String.length value) in
   String.iter (fun c ->
     match c with
     | '&' -> Buffer.add_string buf "&"
     | '"' when quote_char = '"' -> Buffer.add_string buf """
+    | '\'' when quote_char = '\'' -> Buffer.add_string buf "'"
+    | '<' when escape_lt -> Buffer.add_string buf "&lt;"
     | c -> Buffer.add_char buf c
   ) value;
   Buffer.contents buf
 
-let serialize_node node =
+let serialize_node opts ~in_raw_text node =
   match node.Dom.name with
   | "#text" ->
-    (* Check if parent is a raw text element *)
-    escape_text node.Dom.data
+    if in_raw_text && not opts.escape_rcdata then
+      node.Dom.data
+    else
+      escape_text node.Dom.data
   | "#comment" ->
     "<!--" ^ node.Dom.data ^ "-->"
   | "!doctype" ->
···
      | None -> Buffer.add_string buf "html");
     Buffer.add_char buf '>';
     Buffer.contents buf
-  | _ ->
-    (* Element *)
-    let buf = Buffer.create 64 in
-    Buffer.add_char buf '<';
-    Buffer.add_string buf node.Dom.name;
-    List.iter (fun (key, value) ->
-      Buffer.add_char buf ' ';
-      Buffer.add_string buf key;
-      if can_unquote_attr_value value then begin
-        Buffer.add_char buf '=';
-        Buffer.add_string buf value
-      end else begin
-        let quote = choose_quote value in
-        Buffer.add_char buf '=';
-        Buffer.add_char buf quote;
-        Buffer.add_string buf (escape_attr_value value quote);
-        Buffer.add_char buf quote
-      end
-    ) node.Dom.attrs;
-    Buffer.add_char buf '>';
-    Buffer.contents buf
+  | _ -> failwith "serialize_node called with element"
+
+let choose_quote value default_quote explicit =
+  (* If quote_char was explicitly set, always use it *)
+  if explicit then default_quote
+  else
+    (* Otherwise, if value contains the default quote but not the other, use the other *)
+    let has_double = String.contains value '"' in
+    let has_single = String.contains value '\'' in
+    if has_double && not has_single then '\''
+    else if has_single && not has_double then '"'
+    else default_quote
+
+(* Serialize an element tag (start tag) *)
+let serialize_start_tag opts ~is_empty_tag name attrs =
+  let buf = Buffer.create 64 in
+  Buffer.add_char buf '<';
+  Buffer.add_string buf name;
+  (* Sort attributes alphabetically for consistent output *)
+  let sorted_attrs = List.sort (fun (a, _) (b, _) -> String.compare a b) attrs in
+  List.iter (fun (key, value) ->
+    Buffer.add_char buf ' ';
+    Buffer.add_string buf key;
+    let should_minimize =
+      opts.minimize_boolean_attributes &&
+      String.lowercase_ascii key = String.lowercase_ascii value
+    in
+    if should_minimize then
+      ()
+    else if String.length value = 0 then begin
+      Buffer.add_char buf '=';
+      Buffer.add_char buf opts.quote_char;
+      Buffer.add_char buf opts.quote_char
+    end else if can_unquote_attr_value value then begin
+      Buffer.add_char buf '=';
+      Buffer.add_string buf value
+    end else begin
+      let quote = choose_quote value opts.quote_char opts.quote_char_explicit in
+      Buffer.add_char buf '=';
+      Buffer.add_char buf quote;
+      Buffer.add_string buf (escape_attr_value value quote opts.escape_lt_in_attrs);
+      Buffer.add_char buf quote
+    end
+  ) sorted_attrs;
+  if opts.use_trailing_solidus && (is_empty_tag || is_void_element name) then
+    Buffer.add_string buf " /";
+  Buffer.add_char buf '>';
+  Buffer.contents buf
+
+(* Check if text starts with ASCII whitespace *)
+let text_starts_with_space text =
+  String.length text > 0 &&
+  let c = text.[0] in
+  c = '\t' || c = '\n' || c = '\x0C' || c = '\r' || c = ' '
+
+(* Optional tag omission helpers *)
+type next_token =
+  | NTComment
+  | NTSpace  (* Text starting with space *)
+  | NTText   (* Text not starting with space *)
+  | NTStartTag of string
+  | NTEmptyTag of string
+  | NTEndTag of string
+  | NTEOF
+
+let classify_next tokens idx =
+  if idx >= Array.length tokens then NTEOF
+  else match tokens.(idx).token with
+    | None -> NTEOF
+    | Some (CommentNode _) -> NTComment
+    | Some (TextNode text) ->
+      if text_starts_with_space text then NTSpace else NTText
+    | Some (StartTag (name, _)) -> NTStartTag (String.lowercase_ascii name)
+    | Some (EmptyTag (name, _)) -> NTEmptyTag (String.lowercase_ascii name)
+    | Some (EndTag name) -> NTEndTag (String.lowercase_ascii name)
+    | Some (DoctypeNode _) -> NTEOF  (* Treat doctype as if nothing follows *)
+
+(* Should we omit a start tag? *)
+let should_omit_start_tag opts name attrs next =
+  if not opts.omit_optional_tags then false
+  else
+    let name = String.lowercase_ascii name in
+    match name, next with
+    (* html start tag: omit if not followed by comment or space, AND has no attributes *)
+    | "html", NTComment -> false
+    | "html", NTSpace -> false
+    | "html", _ -> attrs = []  (* only omit if no attributes *)
+    (* head start tag: omit if followed by element (start/empty tag) *)
+    | "head", NTStartTag _ -> true
+    | "head", NTEmptyTag _ -> true
+    | "head", NTEndTag "head" -> true  (* empty head *)
+    | "head", NTEOF -> true
+    | "head", _ -> false
+    (* body start tag: omit if not followed by comment or space, AND has no attributes *)
+    | "body", NTComment -> false
+    | "body", NTSpace -> false
+    | "body", _ -> attrs = []  (* only omit if no attributes *)
+    (* colgroup start tag: omit if followed by col element *)
+    | "colgroup", NTStartTag "col" -> true
+    | "colgroup", NTEmptyTag "col" -> true
+    | "colgroup", _ -> false
+    (* tbody start tag: omit if first child is tr *)
+    | "tbody", NTStartTag "tr" -> true
+    | "tbody", _ -> false
+    | _ -> false
+
+(* Should we omit an end tag? *)
+let should_omit_end_tag opts name next =
+  if not opts.omit_optional_tags then false
+  else
+    let name = String.lowercase_ascii name in
+    match name, next with
+    (* html end tag: omit if not followed by comment or space *)
+    | "html", NTComment -> false
+    | "html", NTSpace -> false
+    | "html", _ -> true
+    (* head end tag: omit if not followed by comment or space *)
+    | "head", NTComment -> false
+    | "head", NTSpace -> false
+    | "head", _ -> true
+    (* body end tag: omit if not followed by comment or space *)
+    | "body", NTComment -> false
+    | "body", NTSpace -> false
+    | "body", _ -> true
+    (* li end tag: omit if followed by li start tag or parent end tag *)
+    | "li", NTStartTag "li" -> true
+    | "li", NTEndTag _ -> true
+    | "li", NTEOF -> true
+    | "li", _ -> false
+    (* dt end tag: omit if followed by dt or dd start tag (NOT end tag or EOF!) *)
+    | "dt", NTStartTag "dt" -> true
+    | "dt", NTStartTag "dd" -> true
+    | "dt", _ -> false
+    (* dd end tag: omit if followed by dd or dt start tag, or end tag, or EOF *)
+    | "dd", NTStartTag "dd" -> true
+    | "dd", NTStartTag "dt" -> true
+    | "dd", NTEndTag _ -> true
+    | "dd", NTEOF -> true
+    | "dd", _ -> false
+    (* p end tag: omit if followed by block element (start or empty tag), end tag, or EOF *)
+    | "p", NTStartTag next_name when is_p_closing_element next_name -> true
+    | "p", NTEmptyTag next_name when is_p_closing_element next_name -> true
+    | "p", NTEndTag _ -> true
+    | "p", NTEOF -> true
+    | "p", _ -> false
+    (* optgroup end tag: omit if followed by optgroup start tag, end tag, or EOF *)
+    | "optgroup", NTStartTag "optgroup" -> true
+    | "optgroup", NTEndTag _ -> true
+    | "optgroup", NTEOF -> true
+    | "optgroup", _ -> false
+    (* option end tag: omit if followed by option/optgroup start tag, end tag, or EOF *)
+    | "option", NTStartTag "option" -> true
+    | "option", NTStartTag "optgroup" -> true
+    | "option", NTEndTag _ -> true
+    | "option", NTEOF -> true
+    | "option", _ -> false
+    (* colgroup end tag: omit if not followed by comment, space, or another colgroup *)
+    | "colgroup", NTComment -> false
+    | "colgroup", NTSpace -> false
+    | "colgroup", NTStartTag "colgroup" -> false  (* keep end tag when another colgroup follows *)
+    | "colgroup", _ -> true
+    (* thead end tag: omit if followed by tbody or tfoot start tag *)
+    | "thead", NTStartTag "tbody" -> true
+    | "thead", NTStartTag "tfoot" -> true
+    | "thead", _ -> false
+    (* tbody end tag: omit if followed by tbody/tfoot start tag, end tag, or EOF *)
+    | "tbody", NTStartTag "tbody" -> true
+    | "tbody", NTStartTag "tfoot" -> true
+    | "tbody", NTEndTag _ -> true
+    | "tbody", NTEOF -> true
+    | "tbody", _ -> false
+    (* tfoot end tag: omit if followed by tbody start tag, end tag, or EOF *)
+    | "tfoot", NTStartTag "tbody" -> true
+    | "tfoot", NTEndTag _ -> true
+    | "tfoot", NTEOF -> true
+    | "tfoot", _ -> false
+    (* tr end tag: omit if followed by tr start tag, end tag, or EOF *)
+    | "tr", NTStartTag "tr" -> true
+    | "tr", NTEndTag _ -> true
+    | "tr", NTEOF -> true
+    | "tr", _ -> false
+    (* td end tag: omit if followed by td/th start tag, end tag, or EOF *)
+    | "td", NTStartTag "td" -> true
+    | "td", NTStartTag "th" -> true
+    | "td", NTEndTag _ -> true
+    | "td", NTEOF -> true
+    | "td", _ -> false
+    (* th end tag: omit if followed by th/td start tag, end tag, or EOF *)
+    | "th", NTStartTag "th" -> true
+    | "th", NTStartTag "td" -> true
+    | "th", NTEndTag _ -> true
+    | "th", NTEOF -> true
+    | "th", _ -> false
+    | _ -> false
 
 (* Run a single test *)
 let run_test test =
   try
-    (* Build nodes from input tokens *)
-    let nodes = List.filter_map build_node_from_token test.input in
+    (* Build token infos from input *)
+    let token_infos = Array.of_list (List.map build_token_info test.input) in
+    let num_tokens = Array.length token_infos in
+
+    (* Handle inject_meta_charset option *)
+    let inject_meta = test.options.inject_meta_charset in
+    let encoding = test.options.encoding in
+
+    (* Serialize with context tracking *)
+    let buf = Buffer.create 256 in
+    let in_raw_text = ref false in
+    let preserve_whitespace = ref false in
+    let element_stack : string list ref = ref [] in
+    let in_head = ref false in
+    let meta_charset_injected = ref false in
+    let prev_was_section_end = ref false in  (* Track if prev token was thead/tbody/tfoot end *)
 
-    (* Serialize *)
-    let serialized = String.concat "" (List.map serialize_node nodes) in
+    for i = 0 to num_tokens - 1 do
+      let info = token_infos.(i) in
+      let next = classify_next token_infos (i + 1) in
+
+      match info.token with
+      | None -> ()
+
+      | Some (StartTag (name, attrs)) ->
+        let name_lower = String.lowercase_ascii name in
+
+        (* Track head element *)
+        if name_lower = "head" then in_head := true;
+
+        (* For inject_meta_charset, we need to check if there's any charset meta coming up *)
+        (* If yes, don't inject at head start; if no, inject at head start *)
+        let should_inject_at_head =
+          if not inject_meta || name_lower <> "head" then false
+          else match encoding with
+            | None -> false
+            | Some _ ->
+              (* Look ahead to see if there's a charset meta or http-equiv content-type *)
+              let has_charset_meta = ref false in
+              for j = i + 1 to num_tokens - 1 do
+                match token_infos.(j).token with
+                | Some (EmptyTag (n, a)) when String.lowercase_ascii n = "meta" ->
+                  let has_charset = List.exists (fun (k, _) -> String.lowercase_ascii k = "charset") a in
+                  let has_http_equiv_ct = List.exists (fun (k, v) ->
+                    String.lowercase_ascii k = "http-equiv" && String.lowercase_ascii v = "content-type") a in
+                  if has_charset || has_http_equiv_ct then has_charset_meta := true
+                | Some (EndTag n) when String.lowercase_ascii n = "head" -> ()
+                | _ -> ()
+              done;
+              not !has_charset_meta
+        in
+
+        (* Special case: tbody start tag cannot be omitted if preceded by section end tag *)
+        let can_omit_start =
+          if name_lower = "tbody" && !prev_was_section_end then false
+          else should_omit_start_tag test.options name attrs next
+        in
+        prev_was_section_end := false;  (* Reset for next iteration *)
+
+        if should_inject_at_head then begin
+          meta_charset_injected := true;
+          (* Don't output head start tag if we should omit it *)
+          if not can_omit_start then
+            Buffer.add_string buf (serialize_start_tag test.options ~is_empty_tag:false name attrs);
+          Buffer.add_string buf (Printf.sprintf "<meta charset=%s>" (Option.get encoding));
+          element_stack := name :: !element_stack;
+          if is_raw_text_element name then in_raw_text := true;
+          if is_whitespace_preserving_element name then preserve_whitespace := true
+        end else if not can_omit_start then begin
+          Buffer.add_string buf (serialize_start_tag test.options ~is_empty_tag:false name attrs);
+          element_stack := name :: !element_stack;
+          if is_raw_text_element name then in_raw_text := true;
+          if is_whitespace_preserving_element name then preserve_whitespace := true
+        end else begin
+          element_stack := name :: !element_stack;
+          if is_raw_text_element name then in_raw_text := true;
+          if is_whitespace_preserving_element name then preserve_whitespace := true
+        end
+
+      | Some (EmptyTag (name, attrs)) ->
+        let name_lower = String.lowercase_ascii name in
+        prev_was_section_end := false;  (* Reset for next iteration *)
+
+        (* Handle meta charset replacement *)
+        if inject_meta && !in_head && name_lower = "meta" then begin
+          let has_charset = List.exists (fun (k, _) -> String.lowercase_ascii k = "charset") attrs in
+          let has_http_equiv_ct =
+            List.exists (fun (k, v) ->
+              String.lowercase_ascii k = "http-equiv" &&
+              String.lowercase_ascii v = "content-type"
+            ) attrs
+          in
+          if has_charset then begin
+            (* Replace charset value *)
+            match encoding with
+            | Some enc ->
+              Buffer.add_string buf (Printf.sprintf "<meta charset=%s>" enc)
+            | None -> ()  (* No encoding, skip the meta tag *)
+          end else if has_http_equiv_ct then begin
+            (* Replace charset in content value *)
+            match encoding with
+            | Some enc ->
+              let new_attrs = List.map (fun (k, v) ->
+                if String.lowercase_ascii k = "content" then
+                  let new_content = Printf.sprintf "text/html; charset=%s" enc in
+                  (k, new_content)
+                else (k, v)
+              ) attrs in
+              Buffer.add_string buf (serialize_start_tag test.options ~is_empty_tag:true name new_attrs)
+            | None ->
+              Buffer.add_string buf (serialize_start_tag test.options ~is_empty_tag:true name attrs)
+          end else begin
+            (* Regular meta tag, output as normal *)
+            Buffer.add_string buf (serialize_start_tag test.options ~is_empty_tag:true name attrs)
+          end
+        end else
+          Buffer.add_string buf (serialize_start_tag test.options ~is_empty_tag:true name attrs)
+
+      | Some (EndTag name) ->
+        let name_lower = String.lowercase_ascii name in
+
+        (* Track head element *)
+        if name_lower = "head" then in_head := false;
+
+        (* Pop from element stack *)
+        (match !element_stack with
+         | top :: rest when String.lowercase_ascii top = name_lower ->
+           element_stack := rest;
+           if is_raw_text_element name then in_raw_text := false;
+           if is_whitespace_preserving_element name then preserve_whitespace := false
+         | _ -> ());
+
+        let is_section_end = List.mem name_lower ["thead"; "tbody"; "tfoot"] in
+        let omit = should_omit_end_tag test.options name next in
+
+        if not omit then begin
+          Buffer.add_string buf "</";
+          Buffer.add_string buf name;
+          Buffer.add_char buf '>'
+        end;
+
+        (* Track if we omitted a section end tag - next tbody can't be omitted *)
+        prev_was_section_end := is_section_end && omit
+
+      | Some (TextNode text) ->
+        prev_was_section_end := false;
+        let processed_text =
+          if !in_raw_text && not test.options.escape_rcdata then
+            text
+          else if test.options.strip_whitespace && not !preserve_whitespace then
+            escape_text (collapse_whitespace text)
+          else
+            escape_text text
+        in
+        Buffer.add_string buf processed_text
+
+      | Some (CommentNode text) ->
+        prev_was_section_end := false;
+        Buffer.add_string buf "<!--";
+        Buffer.add_string buf text;
+        Buffer.add_string buf "-->"
+
+      | Some (DoctypeNode node) ->
+        prev_was_section_end := false;
+        Buffer.add_string buf (serialize_node test.options ~in_raw_text:false node)
+    done;
+
+    let serialized = Buffer.contents buf in
 
     (* Check if it matches any expected output *)
     let matches = List.exists (fun exp -> serialized = exp) test.expected in

test/test_tokenizer.ml

···
   initial_states : string list;
   last_start_tag : string option;
   double_escaped : bool;
+  xml_mode : bool;
 }
 
 (* Unescape double-escaped strings from tests *)
···
   }
 
 (* Parse a single test case from JSON *)
-let parse_test_case json =
+let parse_test_case ~xml_mode json =
   let obj = json_object json in
   let description = json_string (json_mem_exn "description" obj) in
   let input = json_string (json_mem_exn "input" obj) in
···
     | Some b -> json_bool b
     | None -> false
   in
-  { description; input; output; errors; initial_states; last_start_tag; double_escaped }
+  { description; input; output; errors; initial_states; last_start_tag; double_escaped; xml_mode }
 
 (* Convert state name to State.t *)
 let state_of_string = function
···
   let input = if test.double_escaped then unescape_double test.input else test.input in
 
   let collector = TokenCollector.create () in
-  let tokenizer = Tokenizer.create (module TokenCollector) collector ~collect_errors:true () in
+  let tokenizer = Tokenizer.create (module TokenCollector) collector ~collect_errors:true ~xml_mode:test.xml_mode () in
 
   (* Set initial state *)
   Tokenizer.set_state tokenizer initial_state;
···
 
   let obj = json_object json in
 
-  (* Handle both {"tests": [...]} and {"xmlViolationTests": [...], "tests": [...]} formats *)
-  let test_arrays =
-    let tests = match json_mem "tests" obj with
-      | Some t -> json_array t
-      | None -> []
-    in
-    let xml_tests = match json_mem "xmlViolationTests" obj with
-      | Some t -> json_array t
-      | None -> []
-    in
-    tests @ xml_tests
+  (* Handle both {"tests": [...]} and {"xmlViolationTests": [...]} formats *)
+  let regular_tests =
+    match json_mem "tests" obj with
+    | Some t -> List.map (parse_test_case ~xml_mode:false) (json_array t)
+    | None -> []
+  in
+  let xml_tests =
+    match json_mem "xmlViolationTests" obj with
+    | Some t -> List.map (parse_test_case ~xml_mode:true) (json_array t)
+    | None -> []
   in
+  let all_tests = regular_tests @ xml_tests in
 
   let filename = Filename.basename path in
   let passed = ref 0 in
   let failed = ref 0 in
   let first_failures = ref [] in
 
-  List.iteri (fun i test_json ->
-    let test = parse_test_case test_json in
+  List.iteri (fun i test ->
+    (* test is already parsed *)
 
     (* Run for each initial state *)
     List.iter (fun state_name ->
···
           first_failures := (i + 1, test.description, state_name, [], [], [], []) :: !first_failures;
         Printf.eprintf "Exception in test %d (%s): %s\n" (i + 1) test.description (Printexc.to_string e)
     ) test.initial_states
-  ) test_arrays;
+  ) all_tests;
 
   (!passed, !failed, List.rev !first_failures, filename)