| a | b
\ No newline at end of file
diff --git a/test/fuzz/seeds/malformed.html b/test/fuzz/seeds/malformed.html
new file mode 100644
index 0000000..aa7323c
--- /dev/null
+++ b/test/fuzz/seeds/malformed.html
@@ -0,0 +1 @@
+ x ";
+ agrees "empty" "ab";
+ ];
+ "doctype"
+ >::: [
+ agrees "lowercase" "x ";
+ agrees "uppercase" "text";
+ ];
+ "br end tag"
+ >::: [ agrees "between text" "xy"; agrees "alone" "" ];
+ "self-closing"
+ >::: [ agrees "div" "x"; agrees "span and b" "xy" ];
+ "rcdata"
+ >::: [
+ agrees "textarea start tag" "";
+ agrees "textarea end tag" "x";
+ ];
+ "script escaping"
+ >::: [
+ agrees "escaped close tag"
+ " -->";
+ agrees "double escaped"
+ "y";
+ ];
+ "lenient entities"
+ >::: [
+ agrees "named without semicolon" "a&b";
+ agrees "numeric without semicolon" "x&y";
+ agrees "attribute named without semicolon"
+ "x ";
+ ];
+ "invalid utf8"
+ >::: [
+ agrees "leading byte" "\xffx ";
+ agrees "byte in text" "a\xffb ";
+ agrees "continuation bytes" "\xb5\x95";
+ ];
+ "declared encoding"
+ >::: [
+ agrees_utf_8 "explicit UTF-8 ignores declaration"
+ "\xC3\xA9";
+ agrees "windows-1251"
+ " \xCF\xF0\xE8\xE2\xE5\xF2";
+ agrees "baseline windows-1251 D0 mapping"
+ " \xD0";
+ agrees "HTML iso-8859-1 is windows-1252"
+ " caf\xE9";
+ agrees "bare charset text is ignored"
+ " charset=windows-1252 \xC3\xA9";
+ agrees "charset in a comment is ignored"
+ " \xC3\xA9";
+ agrees "charset in a quoted attribute is ignored"
+ " \xC3\xA9";
+ agrees "content pragma"
+ " \xE9";
+ agrees "pragma after content"
+ " \xE9";
+ agrees "content without pragma is ignored"
+ " \xC3\xA9";
+ agrees "duplicate charset attribute keeps the first"
+ " \xCF";
+ agrees "UTF-8 BOM takes precedence"
+ "\xEF\xBB\xBF caf\xC3\xA9";
+ ];
+ "crlf"
+ >::: [
+ agrees "crlf in text" " a\r\nb "; agrees "lone cr" "a\rb";
+ ];
+ "bom"
+ >::: [
+ agrees "leading bom" "\xEF\xBB\xBFa";
+ agrees_with_text "internal bom is preserved" "a\xEF\xBB\xBFb"
+ "a\xEF\xBB\xBFb";
+ agrees "two leading boms" "\xEF\xBB\xBF\xEF\xBB\xBFa";
+ agrees "UTF-16LE bom"
+ "\xFF\xFE\x3C\x00\x70\x00\x3E\x00\xE9\x00\x3C\x00\x2F\x00\x70\x00\x3E\x00";
+ agrees "UTF-16BE bom"
+ "\xFE\xFF\x00\x3C\x00\x70\x00\x3E\x00\xE9\x00\x3C\x00\x2F\x00\x70\x00\x3E";
+ agrees_encoding "explicit UTF-16LE" Markup.Encoding.utf_16le
+ `UTF_16LE
+ "\x3C\x00\x70\x00\x3E\x00\x78\x00\x3C\x00\x2F\x00\x70\x00\x3E\x00";
+ ];
+ "table whitespace"
+ >::: [
+ agrees "before colgroup" "";
+ agrees "between rows"
+ "";
+ ];
+ "attributes"
+ >::: [
+ agrees "source order" "x";
+ agrees "duplicates" " x";
+ ];
+ "garbage tags"
+ >::: [
+ agrees "at sign in name" "z";
+ agrees "with attribute and end tag"
+ "t";
+ ];
+ "tag open text"
+ >::: [
+ agrees "empty tag" "<>x";
+ agrees "comparison operators" "text < 5 and > 3";
+ agrees "space before name" "< div>x";
+ ];
+ "attribute names"
+ >::: [
+ agrees "quote as name" "x";
+ agrees "equals as name" " x";
+ agrees "control character in name" " x";
+ ];
+ "rawtext elements"
+ >::: [
+ agrees "noembed" "<![CDATA[<span>x]]>y";
+ agrees "xmp" " <![CDATA[a<b>c]]>d";
+ ];
+ "plaintext"
+ >::: [
+ agrees "swallows rest" " <![CDATA[a<b>";
+ agrees "end tag is text" "<plaintext>x</plaintext>y";
+ ];
+ "fragment foreign"
+ >::: [
+ agrees ~context:(`Fragment "svg") "td in svg" "<td>x";
+ agrees ~context:(`Fragment "svg") "div span in svg"
+ "<div><span></div>";
+ ];
+ "parse_tokens"
+ >::: [
+ ( "document" >:: fun _ ->
+ let tokens =
+ [
+ ((1, 1), `Start (token_tag "p"));
+ ((1, 4), `String "x");
+ ((1, 5), `End (token_tag "p"));
+ ((1, 9), `EOF);
+ ]
+ in
+ assert_equal ~printer:print_signals
+ (lite `Document "<p>x</p>")
+ (lite_tokens `Document tokens) );
+ ( "fragment" >:: fun _ ->
+ let tokens = [ ((1, 1), `String "<b>"); ((1, 4), `EOF) ] in
+ assert_equal ~printer:print_signals
+ (lite (`Fragment "textarea") "<b>")
+ (lite_tokens (`Fragment "textarea") tokens) );
+ ( "report location" >:: fun _ ->
+ let reports = ref [] in
+ let tokens =
+ [ ((7, 11), `End (token_tag "p")); ((7, 15), `EOF) ]
+ in
+ ignore
+ (lite_tokens
+ ~report:(fun location error ->
+ reports := (location, error) :: !reports)
+ `Document tokens);
+ assert_bool "token location was not reported"
+ (List.exists
+ (fun (location, _) -> location = (7, 11))
+ !reports) );
+ ];
+ "foreign breakout reentry"
+ >::: [
+ agrees "svg b svg text" "<svg><b><svg>ab";
+ agrees "math b math text" "<math><b><math>xy";
+ agrees "svg s svg digits" "<svg><s><svg>00";
+ ];
+ "cdata in foreign content"
+ >::: [
+ agrees "svg" "<svg><![CDATA[a]]]]><![CDATA[></svg>";
+ agrees "math" "<math><![CDATA[1]]]]><![CDATA[></math>";
+ ];
+ "form feed whitespace"
+ >::: [
+ agrees "alone" "\x0C";
+ agrees "after col" "<table><col>\x0C";
+ agrees "after template" "<template></template>\x0C";
+ ];
+ "nul does not reconstruct formatting"
+ >::: [
+ agrees "p b p" "<p><b><p>\x00";
+ agrees "li s li" "<li><s><li>\x00<p";
+ ];
+ "fragment breakout rawtext eof"
+ >::: [
+ agrees ~context:(`Fragment "svg") "style slash"
+ "<p></p><style></";
+ agrees ~context:(`Fragment "svg") "script candidate"
+ "<p></p><script></x";
+ agrees ~context:(`Fragment "math") "style candidate"
+ "<p></p><style></x";
+ agrees "document candidate" "<style></x";
+ agrees ~context:(`Fragment "svg") "complete candidate"
+ "<p></p><style></x>";
+ ];
+ "termination" >::: [ terminates; bounded_agreement ];
+ ])
diff --git a/test/lite/lite_count_corpus.ml b/test/lite/lite_count_corpus.ml
new file mode 100644
index 0000000..c65ca40
--- /dev/null
+++ b/test/lite/lite_count_corpus.ml
@@ -0,0 +1,230 @@
+type parser_selection = Both | Oracle | Lite
+
+let arguments () =
+ let selection = ref Both in
+ let directories = ref [] in
+ let parser = function
+ | "both" -> selection := Both
+ | "oracle" -> selection := Oracle
+ | "lite" -> selection := Lite
+ | _ -> assert false
+ in
+ let usage =
+ Printf.sprintf "Usage: %s [--parser both|oracle|lite] DIRECTORY"
+ Sys.argv.(0)
+ in
+ let specs =
+ [
+ ( "--parser",
+ Arg.Symbol ([ "both"; "oracle"; "lite" ], parser),
+ " Select which parser to run (default: both)" );
+ ]
+ in
+ Arg.parse specs
+ (fun directory -> directories := directory :: !directories)
+ usage;
+ match !directories with
+ | [ directory ] -> (!selection, directory)
+ | _ ->
+ Arg.usage specs usage;
+ exit 2
+
+let html_files directory =
+ let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in
+ let rec collect acc =
+ match files () with
+ | None -> List.sort String.compare acc
+ | Some path ->
+ let path = CCIO.File.to_string path in
+ collect
+ (if Filename.check_suffix path ".html" then path :: acc else acc)
+ in
+ collect []
+
+type stats = {
+ mutable wall_seconds : float;
+ mutable user_seconds : float;
+ mutable system_seconds : float;
+ mutable minor_words : float;
+ mutable major_words : float;
+ mutable promoted_words : float;
+ mutable allocated_words : float;
+ mutable minor_collections : int;
+ mutable major_collections : int;
+ mutable compactions : int;
+}
+
+let empty_stats () =
+ {
+ wall_seconds = 0.;
+ user_seconds = 0.;
+ system_seconds = 0.;
+ minor_words = 0.;
+ major_words = 0.;
+ promoted_words = 0.;
+ allocated_words = 0.;
+ minor_collections = 0;
+ major_collections = 0;
+ compactions = 0;
+ }
+
+let measure stats f =
+ let gc_before = Gc.quick_stat () in
+ let allocated_before = Gc.allocated_bytes () in
+ let cpu_before = Unix.times () in
+ let wall_before = Unix.gettimeofday () in
+ let result = f () in
+ let wall_after = Unix.gettimeofday () in
+ let cpu_after = Unix.times () in
+ let gc_after = Gc.quick_stat () in
+ let allocated_after = Gc.allocated_bytes () in
+ stats.wall_seconds <- stats.wall_seconds +. wall_after -. wall_before;
+ stats.user_seconds <-
+ stats.user_seconds +. cpu_after.tms_utime -. cpu_before.tms_utime;
+ stats.system_seconds <-
+ stats.system_seconds +. cpu_after.tms_stime -. cpu_before.tms_stime;
+ stats.minor_words <-
+ stats.minor_words +. gc_after.minor_words -. gc_before.minor_words;
+ stats.major_words <-
+ stats.major_words +. gc_after.major_words -. gc_before.major_words;
+ stats.promoted_words <-
+ stats.promoted_words +. gc_after.promoted_words -. gc_before.promoted_words;
+ stats.allocated_words <-
+ stats.allocated_words
+ +. ((allocated_after -. allocated_before) /. (float Sys.word_size /. 8.));
+ stats.minor_collections <-
+ stats.minor_collections + gc_after.minor_collections
+ - gc_before.minor_collections;
+ stats.major_collections <-
+ stats.major_collections + gc_after.major_collections
+ - gc_before.major_collections;
+ stats.compactions <-
+ stats.compactions + gc_after.compactions - gc_before.compactions;
+ result
+
+type outcome = Count of int | Raised of string
+
+let count iter stream =
+ let count = ref 0 in
+ iter (fun _ -> incr count) stream;
+ !count
+
+let run f = try Count (f ()) with exn -> Raised (Printexc.to_string exn)
+
+let count_oracle html =
+ run (fun () ->
+ Oracle.parse ~context:`Document (fun _ _ -> ()) html |> count Markup.iter)
+
+let count_lite html =
+ run (fun () ->
+ Markup_lite.parse_html ~context:`Document html |> count Markup_lite.iter)
+
+let compare path oracle lite =
+ match (oracle, lite) with
+ | Count oracle, Count lite when oracle = lite -> Some oracle
+ | Raised oracle, Raised lite when oracle = lite -> Some 0
+ | Count oracle, Count lite ->
+ Printf.eprintf "%s: signal count differs: oracle=%d lite=%d\n" path oracle
+ lite;
+ None
+ | Raised oracle, Raised lite ->
+ Printf.eprintf "%s: exception differs:\n oracle: %s\n lite: %s\n" path
+ oracle lite;
+ None
+ | Raised exception_, Count count ->
+ Printf.eprintf "%s: oracle raised but Lite produced %d signals: %s\n" path
+ count exception_;
+ None
+ | Count count, Raised exception_ ->
+ Printf.eprintf "%s: Lite raised but oracle produced %d signals: %s\n" path
+ count exception_;
+ None
+
+let print_stats name bytes stats =
+ let mib = float bytes /. 1048576. in
+ Printf.printf
+ "%s: wall_seconds=%.6f user_seconds=%.6f system_seconds=%.6f \
+ throughput_mib_s=%.2f allocated_words=%.0f minor_words=%.0f \
+ major_words=%.0f promoted_words=%.0f minor_collections=%d \
+ major_collections=%d compactions=%d\n"
+ name stats.wall_seconds stats.user_seconds stats.system_seconds
+ (mib /. stats.wall_seconds)
+ stats.allocated_words stats.minor_words stats.major_words
+ stats.promoted_words stats.minor_collections stats.major_collections
+ stats.compactions
+
+let run_one name count_parser files =
+ let stats = empty_stats () in
+ let bytes = ref 0 in
+ let signals = ref 0 in
+ let exceptions = ref 0 in
+ List.iteri
+ (fun index path ->
+ let html = CCIO.File.read_exn (CCIO.File.make path) in
+ bytes := !bytes + String.length html;
+ begin match measure stats (fun () -> count_parser html) with
+ | Count count -> signals := !signals + count
+ | Raised _ -> incr exceptions
+ end;
+ if (index + 1) mod 100 = 0 then
+ Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files))
+ files;
+ Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files);
+ Printf.printf "files=%d bytes=%d signals=%d exceptions=%d\n"
+ (List.length files) !bytes !signals !exceptions;
+ print_stats (name ^ " count") !bytes stats;
+ Printf.printf "OK: %d HTML files consumed with %s\n%!" (List.length files)
+ name
+
+let run_both files =
+ let failures = ref 0 in
+ let bytes = ref 0 in
+ let signals = ref 0 in
+ let oracle_stats = empty_stats () in
+ let lite_stats = empty_stats () in
+ List.iteri
+ (fun index path ->
+ let html = CCIO.File.read_exn (CCIO.File.make path) in
+ bytes := !bytes + String.length html;
+ let oracle, lite =
+ if index mod 2 = 0 then begin
+ let oracle = measure oracle_stats (fun () -> count_oracle html) in
+ let lite = measure lite_stats (fun () -> count_lite html) in
+ (oracle, lite)
+ end
+ else begin
+ let lite = measure lite_stats (fun () -> count_lite html) in
+ let oracle = measure oracle_stats (fun () -> count_oracle html) in
+ (oracle, lite)
+ end
+ in
+ begin match compare path oracle lite with
+ | Some count -> signals := !signals + count
+ | None -> incr failures
+ end;
+ if (index + 1) mod 100 = 0 then
+ Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files))
+ files;
+ Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files);
+ Printf.printf "files=%d bytes=%d signals=%d\n" (List.length files) !bytes
+ !signals;
+ print_stats "oracle count" !bytes oracle_stats;
+ print_stats "lite count" !bytes lite_stats;
+ if !failures <> 0 then begin
+ Printf.eprintf "FAILED: %d files differed\n" !failures;
+ exit 1
+ end;
+ Printf.printf "OK: %d HTML files had equal signal counts\n%!"
+ (List.length files)
+
+let () =
+ let selection, directory = arguments () in
+ let files = html_files directory in
+ if files = [] then begin
+ Printf.eprintf "No .html files found under: %s\n" directory;
+ exit 2
+ end;
+ match selection with
+ | Both -> run_both files
+ | Oracle -> run_one "oracle" count_oracle files
+ | Lite -> run_one "lite" count_lite files
diff --git a/test/lite/lite_diff_corpus.ml b/test/lite/lite_diff_corpus.ml
new file mode 100644
index 0000000..efaf3f3
--- /dev/null
+++ b/test/lite/lite_diff_corpus.ml
@@ -0,0 +1,181 @@
+let usage program =
+ Printf.eprintf "Usage: %s DIRECTORY\n" program;
+ exit 2
+
+let html_files directory =
+ let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in
+ let rec collect acc =
+ match files () with
+ | None -> List.sort String.compare acc
+ | Some path ->
+ let path = CCIO.File.to_string path in
+ collect
+ (if Filename.check_suffix path ".html" then path :: acc else acc)
+ in
+ collect []
+
+let collect iter stream =
+ let values = ref [] in
+ iter (fun value -> values := value :: !values) stream;
+ List.rev !values
+
+let equal_lists equal left right =
+ let rec loop left right =
+ match (left, right) with
+ | [], [] -> true
+ | l :: ls, r :: rs when equal l r -> loop ls rs
+ | _ -> false
+ in
+ loop left right
+
+let first_difference to_string left right =
+ let rec loop index left right =
+ match (left, right) with
+ | [], [] -> "no difference"
+ | [], _ :: _ -> Printf.sprintf "left ended at signal %d" index
+ | _ :: _, [] -> Printf.sprintf "right ended at signal %d" index
+ | l :: ls, r :: rs ->
+ if l = r then loop (index + 1) ls rs
+ else
+ Printf.sprintf "signal %d:\n oracle: %s\n lite: %s" index
+ (to_string l) (to_string r)
+ in
+ loop 0 left right
+
+type result =
+ | Parsed of
+ Markup_common.signal list
+ * (Markup_common.location * Markup_common.Error.t) list
+ | Raised of string * (Markup_common.location * Markup_common.Error.t) list
+
+type stats = { mutable wall_seconds : float; mutable minor_words : float }
+
+let empty_stats () = { wall_seconds = 0.; minor_words = 0. }
+
+let measure stats f =
+ let minor_words_before = (Gc.quick_stat ()).minor_words in
+ let wall_before = Unix.gettimeofday () in
+ let result = f () in
+ stats.wall_seconds <-
+ stats.wall_seconds +. Unix.gettimeofday () -. wall_before;
+ stats.minor_words <-
+ stats.minor_words +. (Gc.quick_stat ()).minor_words -. minor_words_before;
+ result
+
+let run parse collect_signals html =
+ let errors = ref [] in
+ let report location error = errors := (location, error) :: !errors in
+ try Parsed (collect_signals (parse report html), List.rev !errors)
+ with exn -> Raised (Printexc.to_string exn, List.rev !errors)
+
+let compare path oracle lite =
+ match (oracle, lite) with
+ | Parsed (oracle_signals, oracle_errors), Parsed (lite_signals, lite_errors)
+ ->
+ if not (equal_lists ( = ) oracle_signals lite_signals) then begin
+ Printf.eprintf "%s: signal mismatch: %s\n" path
+ (first_difference Markup_common.signal_to_string oracle_signals
+ lite_signals);
+ false
+ end
+ else if not (equal_lists ( = ) oracle_errors lite_errors) then begin
+ Printf.eprintf "%s: error/location mismatch\n" path;
+ false
+ end
+ else true
+ | Raised (oracle_exn, oracle_errors), Raised (lite_exn, lite_errors) ->
+ if oracle_exn = lite_exn && equal_lists ( = ) oracle_errors lite_errors
+ then true
+ else begin
+ Printf.eprintf "%s: exception mismatch:\n oracle: %s\n lite: %s\n"
+ path oracle_exn lite_exn;
+ false
+ end
+ | Raised (exn, _), Parsed _ ->
+ Printf.eprintf "%s: oracle raised but Lite did not: %s\n" path exn;
+ false
+ | Parsed _, Raised (exn, _) ->
+ Printf.eprintf "%s: Lite raised but oracle did not: %s\n" path exn;
+ false
+
+let check_case name html =
+ let oracle = run Oracle.parse (collect Markup.iter) html in
+ let lite =
+ run
+ (fun report html -> Markup_lite.parse_html ~report html)
+ (collect Markup_lite.iter) html
+ in
+ if not (compare name oracle lite) then exit 1
+
+let check_decoder_cases () =
+ [
+ ("decoder empty", "");
+ ("decoder ASCII without ampersand", "<p>plain ASCII text</p>");
+ ("decoder UTF-8 without ampersand", "<p title=\"été 東京\">naïve ✓</p>");
+ ( "decoder attributes without ampersand",
+ "<div data-value=\"${value}\">x</div>" );
+ ("decoder complete references", "<p title=\"a&b\"><>></p>");
+ ("decoder incomplete references", "<p>a& b& b b*</p>");
+ ]
+ |> List.iter (fun (name, html) -> check_case name html)
+
+let check_depth_limit () =
+ let html = "<div><span></div>" in
+ let oracle = run (Oracle.parse ~depth_limit:1) (collect Markup.iter) html in
+ let lite =
+ run
+ (fun report html -> Markup_lite.parse_html ~report ~depth_limit:1 html)
+ (collect Markup_lite.iter) html
+ in
+ match (oracle, lite) with
+ | Raised _, Raised _ ->
+ if not (compare "depth-limit check" oracle lite) then exit 1
+ | _ ->
+ Printf.eprintf "depth-limit check: expected both parsers to raise\n";
+ exit 1
+
+let () =
+ check_decoder_cases ();
+ check_depth_limit ();
+ let directory =
+ match Array.to_list Sys.argv with
+ | [ _; directory ] -> directory
+ | _ -> usage Sys.argv.(0)
+ in
+ let files = html_files directory in
+ if files = [] then begin
+ Printf.eprintf "No .html files found under: %s\n" directory;
+ exit 2
+ end;
+ let failures = ref 0 in
+ let oracle_stats = empty_stats () in
+ let lite_stats = empty_stats () in
+ List.iteri
+ (fun index path ->
+ let html = CCIO.File.read_exn (CCIO.File.make path) in
+ let oracle =
+ measure oracle_stats (fun () ->
+ run Oracle.parse (collect Markup.iter) html)
+ in
+ let lite =
+ measure lite_stats (fun () ->
+ run
+ (fun report html -> Markup_lite.parse_html ~report html)
+ (collect Markup_lite.iter) html)
+ in
+ if not (compare path oracle lite) then incr failures;
+ if (index + 1) mod 100 = 0 then
+ Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files))
+ files;
+ Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files);
+ Printf.printf
+ "oracle: wall_seconds=%.6f minor_words=%.0f\n\
+ lite: wall_seconds=%.6f minor_words=%.0f\n\
+ %!"
+ oracle_stats.wall_seconds oracle_stats.minor_words lite_stats.wall_seconds
+ lite_stats.minor_words;
+ if !failures <> 0 then begin
+ Printf.eprintf "FAILED: %d files differed\n" !failures;
+ exit 1
+ end;
+ Printf.printf "OK: %d HTML files matched exactly\n%!" (List.length files)
diff --git a/test/lite/lite_dump_signals.ml b/test/lite/lite_dump_signals.ml
new file mode 100644
index 0000000..cb8bf86
--- /dev/null
+++ b/test/lite/lite_dump_signals.ml
@@ -0,0 +1,59 @@
+let collect iter stream =
+ let values = ref [] in
+ iter (fun value -> values := value :: !values) stream;
+ List.rev !values
+
+type outcome = Signals of Markup_common.signal list | Raised of string
+
+let run parse collect_signals input =
+ try Signals (collect_signals (parse input))
+ with exn -> Raised (Printexc.to_string exn)
+
+let context_of_input input : [ `Document | `Fragment of string ] * string =
+ let prefix = "FRAGMENT " in
+ let plen = String.length prefix in
+ if String.length input >= plen && String.sub input 0 plen = prefix then
+ match String.index_from_opt input plen '\n' with
+ | Some nl ->
+ ( `Fragment (String.sub input plen (nl - plen)),
+ String.sub input (nl + 1) (String.length input - nl - 1) )
+ | None -> (`Document, input)
+ else (`Document, input)
+
+let oracle context input =
+ run
+ (fun input -> Oracle.parse ~context (fun _ _ -> ()) input)
+ (collect Markup.iter) input
+
+let lite context input =
+ run
+ (fun input -> Markup_lite.parse_html ~context input)
+ (collect Markup_lite.iter) input
+
+let print label = function
+ | Raised exn -> Printf.printf "%s: RAISED %S\n" label exn
+ | Signals signals ->
+ Printf.printf "%s: %d signals\n" label (List.length signals);
+ List.iteri
+ (fun i signal ->
+ Printf.printf " %d: %S\n" i (Markup_common.signal_to_string signal))
+ signals
+
+let read_all channel =
+ let buffer = Buffer.create 4096 in
+ (try
+ while true do
+ Buffer.add_channel buffer channel 1
+ done
+ with End_of_file -> ());
+ Buffer.contents buffer
+
+let () =
+ let input = read_all stdin in
+ let context, input = context_of_input input in
+ Printf.printf "input: %S\n%!" input;
+ Printf.eprintf "oracle...\n%!";
+ print "oracle" (oracle context input);
+ Printf.eprintf "lite...\n%!";
+ print "lite" (lite context input);
+ Printf.eprintf "done\n%!"
diff --git a/test/lite/lite_fuzz_regression.ml b/test/lite/lite_fuzz_regression.ml
new file mode 100644
index 0000000..f19667b
--- /dev/null
+++ b/test/lite/lite_fuzz_regression.ml
@@ -0,0 +1,201 @@
+(* Regression cases minimized from the 2026-08-27 Lite differential fuzzing
+ corpus. The devkit-backed parser is the oracle for all of these cases. *)
+
+open OUnit2
+
+let collect iter stream =
+ let signals = ref [] in
+ iter (fun signal -> signals := signal :: !signals) stream;
+ List.rev !signals
+
+let oracle html = collect Markup.iter (Oracle.parse (fun _ _ -> ()) html)
+
+let lite html =
+ collect Markup_lite.iter (Markup_lite.parse_html ~report:(fun _ _ -> ()) html)
+
+let print_signals signals =
+ signals
+ |> List.map Markup_common.signal_to_string
+ |> String.concat "\n " |> Printf.sprintf "\n %s"
+
+let agrees name html =
+ name >:: fun _ ->
+ assert_equal ~printer:print_signals (oracle html) (lite html)
+
+let adapted_oracle html =
+ let tokens = Oracle.adapt html in
+ collect Markup.iter
+ (Oracle.parse_adapted ~context:`Document (fun _ _ -> ()) tokens)
+
+let adapted_lite html =
+ let tokens = Oracle.adapt html in
+ collect Markup_lite.iter
+ (Oracle.parse_lite_adapted ~context:`Document (fun _ _ -> ()) tokens)
+
+let adapted_agrees name html =
+ name >:: fun _ ->
+ assert_equal ~printer:print_signals (adapted_oracle html) (adapted_lite html)
+
+(* [adapted_agrees] compares signals only. These two also need the error
+ stream: the 2026-09-03 divergences below were error-only or error-visible. *)
+let adapted_outcome parse html =
+ let tokens = Oracle.adapt html in
+ let errors = ref [] in
+ let report location error = errors := (location, error) :: !errors in
+ let signals = parse report tokens in
+ ( List.map Markup_common.signal_to_string signals,
+ List.rev_map
+ (fun ((line, column), error) ->
+ Printf.sprintf "(%d,%d) %s" line column
+ (Markup_common.Error.to_string error))
+ !errors )
+
+let adapted_oracle_outcome =
+ adapted_outcome (fun report tokens ->
+ collect Markup.iter
+ (Oracle.parse_adapted ~context:`Document report tokens))
+
+let adapted_lite_outcome =
+ adapted_outcome (fun report tokens ->
+ collect Markup_lite.iter
+ (Oracle.parse_lite_adapted ~context:`Document report tokens))
+
+let print_outcome (signals, errors) =
+ Printf.sprintf "\n %s" (String.concat "\n " (signals @ errors))
+
+let adapted_agrees_with_errors name html =
+ name >:: fun _ ->
+ assert_equal ~printer:print_outcome
+ (adapted_oracle_outcome html)
+ (adapted_lite_outcome html)
+
+let lite_parses name html = name >:: fun _ -> ignore (lite html)
+
+let rawtext_failures =
+ [
+ ("garbage script at EOF", "<script/;>");
+ ("garbage script with content at EOF", "<script//>x");
+ ("garbage script with close tag", "<script/x>alert(1)</script>done");
+ ("garbage title", "<title/x>a rest</title>done");
+ ("garbage style", "<style/x>p{}</style>done");
+ ("garbage in attribute position (/=)", "<script /=>x</script>y");
+ ("garbage in attribute position (=)", "<script =>x</script>y");
+ ("garbage after retained attribute", "<script a/b>x</script>y");
+ ("less-than inside rawtext start tag", "ex<script\001more<b>");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let rawtext_guards =
+ [
+ ("non-rawtext slash garbage", "<b/x>text");
+ ("non-rawtext less-than garbage", "<div foo<bar>text");
+ ("rawtext garbage after valued attribute", "<script foo=1//>x");
+ ("valid self-closing script", "<script />x");
+ ("normal rawtext EOF", "<script>x");
+ ("control character is tag whitespace", "<scripT\001more>x");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let entity_failures =
+ [
+ ("text surrogate numeric reference", "x�y");
+ ("text first surrogate numeric reference", "x�");
+ ("text U+FFFF numeric reference", "");
+ ("text literal U+FFFE", "\239\191\190&");
+ ("text literal U+FFFF with unknown entity", "\239\191\191&arp;");
+ ("text literal U+FFFF leaves whole chunk raw", "\239\191\191&a&");
+ ("attribute surrogate numeric reference", "<b c=\"�\">x</b>");
+ ("attribute literal U+FFFF", "<b c=\"\239\191\191&\">x</b>");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let entity_guards =
+ [
+ ("unknown entity", "&arp;");
+ ("zero numeric reference", "x�y");
+ ("out-of-range numeric reference", "x�y");
+ ("ordinary named entity", "a&b");
+ ("other BMP noncharacter", "xy");
+ ("other supplementary noncharacter", "xy");
+ ("literal replacement character", "\239\191\189&");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let tree_builder_failures =
+ [
+ adapted_agrees "foreign buffered text run" "<math><b><svg>eP";
+ agrees "Lite require_current_element"
+ "<template><td><svg></td><tbody/><title></title><></U>";
+ lite_parses "empty stack after formatting element"
+ "<table><script></script><><s></script><td><svg></td><tr/><s/>";
+ agrees "Lite above_in_stack"
+ "<table><td><b><table><td><svg></td><script></script><><tr/><tr><td><svg></td></tr>M<P></b>";
+ ]
+
+let candidate_recovery_failures =
+ [
+ ("dropped xmp empty candidate", "<math><mo><Xmp></");
+ ("dropped xmp named candidate", "<math><mo><xmp></x");
+ ("dropped xmp mid-stream candidate", "<math><mo><xmp></b>c");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let candidate_recovery_guards =
+ [
+ ("emitted rawtext element in foreign", "<math><mo><style></x");
+ ("emitted rawtext element in html", "<div><style></x");
+ ("emitted rcdata element in foreign", "<math><mo><title></x");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let doctype_lookahead_failures =
+ [
+ ("keyword mismatch tail lowercased", "<!doctype a b>XYZw");
+ ("fuzzer case", "<!doctype hte html>L~tmlml><stml><he");
+ ("multibyte window", "<!doctype a X\xc3\xa9>ABCD");
+ ("entity started in window", "<!doctype a b><a");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let doctype_lookahead_guards =
+ [
+ ("public keyword", "<!doctype a public 'x'>YZ");
+ ("gt outside window", "<!doctype a bcdefgh>XY");
+ ("eof inside window", "<!doctype a b>X");
+ ("lowercase tail", "<!doctype a b>xyz<B>T");
+ ]
+ |> List.map (fun (name, html) -> agrees name html)
+
+let pre_newline_pushback =
+ [
+ (* [<a;>] produces no token of its own; it only splits the character run
+ into [String "a\n"; String "\n"]. Lite used to consume the second token
+ inside the [pre] handler and drop it, keeping one newline the oracle
+ dropped. Needs pre/listing + an open formatting element + foreign
+ content: the formatting element keeps the subtree buffer on, so
+ [current_mode] stays pinned to the [pre] continuation and every character
+ of foreign text re-enters it. *)
+ adapted_agrees_with_errors
+ "split foreign text run under pre and a formatting element"
+ "<pre><a><svg>a\n<a;>\n";
+ (* Error-stream only. The empty remainder has to be re-dispatched so that
+ "in table" reports a second [bad content in 'table']. *)
+ adapted_agrees_with_errors
+ "pre as a direct table child with a leading newline" "<table><pre>\n";
+ ]
+
+let () =
+ run_test_tt_main
+ ("Lite fuzz regressions"
+ >::: [
+ "rawtext garbage recovery" >::: rawtext_failures;
+ "rawtext guards" >::: rawtext_guards;
+ "entity chunk fallback" >::: entity_failures;
+ "entity guards" >::: entity_guards;
+ "tree-builder invariants" >::: tree_builder_failures;
+ "doctype keyword lookahead" >::: doctype_lookahead_failures;
+ "doctype lookahead guards" >::: doctype_lookahead_guards;
+ "end-tag candidate recovery" >::: candidate_recovery_failures;
+ "end-tag candidate guards" >::: candidate_recovery_guards;
+ "pre newline push-back" >::: pre_newline_pushback;
+ ])
diff --git a/test/lite/lite_main_entity_regression.ml b/test/lite/lite_main_entity_regression.ml
new file mode 100644
index 0000000..fe98653
--- /dev/null
+++ b/test/lite/lite_main_entity_regression.ml
@@ -0,0 +1,31 @@
+(* This file is part of Markup.ml, released under the MIT license. See
+ LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *)
+
+let html = "<p>²</p>"
+
+let main_signals () =
+ html |> Markup.string
+ |> Markup.parse_html ~context:`Document
+ |> Markup.signals |> Markup.to_list
+
+let lite_signals () =
+ let signals = ref [] in
+ Markup_lite.parse_html html
+ |> Markup_lite.iter (fun signal -> signals := signal :: !signals);
+ List.rev !signals
+
+let print_signals label signals =
+ Printf.eprintf "%s:\n" label;
+ List.iter
+ (fun signal -> Printf.eprintf " %s\n" (Markup.signal_to_string signal))
+ signals
+
+let () =
+ let main = main_signals () in
+ let lite = lite_signals () in
+ if main <> lite then begin
+ Printf.eprintf "Main and Lite differ for %S\n" html;
+ print_signals "Main" main;
+ print_signals "Lite" lite;
+ exit 1
+ end
diff --git a/test/lite/lite_mismatch_regression.ml b/test/lite/lite_mismatch_regression.ml
new file mode 100644
index 0000000..5565467
--- /dev/null
+++ b/test/lite/lite_mismatch_regression.ml
@@ -0,0 +1,50 @@
+(* Representative non-NUL mismatch families from some production mismatches.
+ The production path first adapts HtmlStream tokens, so these tests use the
+ same adapter rather than parsing independently tokenized HTML. *)
+
+open OUnit2
+
+let collect iter stream =
+ let signals = ref [] in
+ iter (fun signal -> signals := signal :: !signals) stream;
+ List.rev !signals
+
+let baseline html =
+ let tokens = Oracle.adapt html in
+ collect Markup.iter
+ (Oracle.parse_adapted ~context:`Document (fun _ _ -> ()) tokens)
+
+let lite html =
+ let tokens = Oracle.adapt html in
+ collect Markup_lite.iter
+ (Oracle.parse_lite_adapted ~context:`Document (fun _ _ -> ()) tokens)
+
+let print_signals signals =
+ signals
+ |> List.map Markup_common.signal_to_string
+ |> String.concat "\n " |> Printf.sprintf "\n %s"
+
+let agrees name html =
+ name >:: fun _ ->
+ assert_equal ~printer:print_signals (baseline html) (lite html)
+
+let () =
+ run_test_tt_main
+ ("production mismatch regressions"
+ >::: [
+ (* Representative of the first-diff-965 gachon.ac.kr pages. *)
+ agrees "paragraph reconstruction across an active anchor"
+ "<p><a href='https://example.test/'>one<p>two";
+ (* Representative of the first-diff-884/885 gachon.ac.kr pages. *)
+ agrees "nested bold reconstruction across a block"
+ "<div><b><b><div>text";
+ (* Representative of the first-diff-992/998 toyless pages. *)
+ agrees "font reconstruction inside a nested div"
+ "<div class='options'><font color='#138f9a'><div id='option'>text";
+ (* Minimized from http://koganeijinja.com/: the trailing newline is
+ required. HtmlStream presents it as a String token. *)
+ agrees "formatting reconstruction after stripped pre newline"
+ "<p><font><pre>\n";
+ agrees "formatting reconstruction after stripped listing newline"
+ "<p><font><listing>\n";
+ ])
diff --git a/test/lite/lite_parser_count_corpus.ml b/test/lite/lite_parser_count_corpus.ml
new file mode 100644
index 0000000..9421b83
--- /dev/null
+++ b/test/lite/lite_parser_count_corpus.ml
@@ -0,0 +1,115 @@
+let usage program =
+ Printf.eprintf "Usage: %s DIRECTORY\n" program;
+ exit 2
+
+let html_files directory =
+ let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in
+ let rec collect acc =
+ match files () with
+ | None -> List.sort String.compare acc
+ | Some path ->
+ let path = CCIO.File.to_string path in
+ collect
+ (if Filename.check_suffix path ".html" then path :: acc else acc)
+ in
+ collect []
+
+let count iter stream =
+ let count = ref 0 in
+ iter (fun _ -> incr count) stream;
+ !count
+
+type stats = {
+ mutable wall : float;
+ mutable user : float;
+ mutable system : float;
+ mutable words : float;
+ mutable minor_collections : int;
+ mutable major_collections : int;
+}
+
+let stats () =
+ {
+ wall = 0.;
+ user = 0.;
+ system = 0.;
+ words = 0.;
+ minor_collections = 0;
+ major_collections = 0;
+ }
+
+let measure stats f =
+ let gc_before = Gc.quick_stat () in
+ let allocated_before = Gc.allocated_bytes () in
+ let cpu_before = Unix.times () in
+ let wall_before = Unix.gettimeofday () in
+ let result = f () in
+ let wall_after = Unix.gettimeofday () in
+ let cpu_after = Unix.times () in
+ let gc_after = Gc.quick_stat () in
+ let allocated_after = Gc.allocated_bytes () in
+ stats.wall <- stats.wall +. wall_after -. wall_before;
+ stats.user <- stats.user +. cpu_after.tms_utime -. cpu_before.tms_utime;
+ stats.system <- stats.system +. cpu_after.tms_stime -. cpu_before.tms_stime;
+ stats.words <-
+ stats.words
+ +. ((allocated_after -. allocated_before) /. (float Sys.word_size /. 8.));
+ stats.minor_collections <-
+ stats.minor_collections + gc_after.minor_collections
+ - gc_before.minor_collections;
+ stats.major_collections <-
+ stats.major_collections + gc_after.major_collections
+ - gc_before.major_collections;
+ result
+
+let print name bytes stats =
+ Printf.printf
+ "%s: wall_seconds=%.6f user_seconds=%.6f system_seconds=%.6f \
+ throughput_mib_s=%.2f allocated_words=%.0f minor_collections=%d \
+ major_collections=%d\n"
+ name stats.wall stats.user stats.system
+ (float bytes /. 1048576. /. stats.wall)
+ stats.words stats.minor_collections stats.major_collections
+
+let () =
+ let directory =
+ match Array.to_list Sys.argv with
+ | [ _; directory ] -> directory
+ | _ -> usage Sys.argv.(0)
+ in
+ let files = html_files directory in
+ if files = [] then usage Sys.argv.(0);
+ let baseline_stats = stats () in
+ let lite_stats = stats () in
+ let bytes = ref 0 in
+ let failures = ref 0 in
+ List.iteri
+ (fun index path ->
+ let html = CCIO.File.read_exn (CCIO.File.make path) in
+ bytes := !bytes + String.length html;
+ (* HtmlStream production and adaptation are outside both timed regions. *)
+ let tokens = Oracle.adapt html in
+ let baseline () =
+ Oracle.parse_adapted ~context:`Document (fun _ _ -> ()) tokens
+ |> count Markup.iter
+ in
+ let lite () =
+ Oracle.parse_lite_adapted ~context:`Document (fun _ _ -> ()) tokens
+ |> count Markup_lite.iter
+ in
+ let baseline_count, lite_count =
+ if index mod 2 = 0 then
+ (measure baseline_stats baseline, measure lite_stats lite)
+ else
+ let lite_count = measure lite_stats lite in
+ (measure baseline_stats baseline, lite_count)
+ in
+ if baseline_count <> lite_count then begin
+ incr failures;
+ Printf.eprintf "%s: signal count differs: %d vs %d\n" path
+ baseline_count lite_count
+ end)
+ files;
+ print "baseline parser-only" !bytes baseline_stats;
+ print "Lite parser-only" !bytes lite_stats;
+ if !failures <> 0 then exit 1
diff --git a/test/lite/lite_parser_diff_corpus.ml b/test/lite/lite_parser_diff_corpus.ml
new file mode 100644
index 0000000..340599e
--- /dev/null
+++ b/test/lite/lite_parser_diff_corpus.ml
@@ -0,0 +1,146 @@
+let usage program =
+ Printf.eprintf "Usage: %s DIRECTORY\n" program;
+ exit 2
+
+let html_files directory =
+ let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in
+ let rec collect acc =
+ match files () with
+ | None -> List.sort String.compare acc
+ | Some path ->
+ let path = CCIO.File.to_string path in
+ collect
+ (if Filename.check_suffix path ".html" then path :: acc else acc)
+ in
+ collect []
+
+let collect iter stream =
+ let values = ref [] in
+ iter (fun value -> values := value :: !values) stream;
+ List.rev !values
+
+exception Timeout
+
+type result =
+ | Parsed of
+ Markup_common.signal list
+ * (Markup_common.location * Markup_common.Error.t) list
+ | Raised of string * (Markup_common.location * Markup_common.Error.t) list
+
+let with_timeout f =
+ let previous =
+ Sys.signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout))
+ in
+ ignore (Unix.alarm 2);
+ Fun.protect
+ ~finally:(fun () ->
+ ignore (Unix.alarm 0);
+ Sys.set_signal Sys.sigalrm previous)
+ f
+
+let run parse collect_signals =
+ let errors = ref [] in
+ let report location error = errors := (location, error) :: !errors in
+ try
+ Parsed
+ (with_timeout (fun () -> collect_signals (parse report)), List.rev !errors)
+ with exn -> Raised (Printexc.to_string exn, List.rev !errors)
+
+let first_difference to_string left right =
+ let rec loop index left right =
+ match (left, right) with
+ | [], [] -> "no difference"
+ | [], _ :: _ -> Printf.sprintf "baseline ended at %d" index
+ | _ :: _, [] -> Printf.sprintf "Lite ended at %d" index
+ | x :: xs, y :: ys ->
+ if x = y then loop (index + 1) xs ys
+ else
+ Printf.sprintf "item %d: baseline=%s Lite=%s" index (to_string x)
+ (to_string y)
+ in
+ loop 0 left right
+
+let error_to_string ((line, column), error) =
+ Printf.sprintf "(%d,%d) %s" line column (Markup_common.Error.to_string error)
+
+let compare name baseline lite =
+ if baseline = lite then true
+ else begin
+ begin match (baseline, lite) with
+ | Parsed (signals, errors), Parsed (lite_signals, lite_errors) ->
+ if signals <> lite_signals then
+ Printf.eprintf "%s: signal mismatch: %s\n" name
+ (first_difference Markup_common.signal_to_string signals
+ lite_signals)
+ else
+ Printf.eprintf "%s: error mismatch: %s\n" name
+ (first_difference error_to_string errors lite_errors)
+ | Raised (exn, _), Raised (lite_exn, _) ->
+ Printf.eprintf "%s: exception mismatch: baseline=%S Lite=%S\n" name exn
+ lite_exn
+ | Raised (exn, _), Parsed _ ->
+ Printf.eprintf "%s: baseline raised %S but Lite parsed\n" name exn
+ | Parsed _, Raised (exn, _) ->
+ Printf.eprintf "%s: Lite raised %S but baseline parsed\n" name exn
+ end;
+ false
+ end
+
+let contexts =
+ [
+ ("document", `Document);
+ ("div-fragment", `Fragment "div");
+ ("table-fragment", `Fragment "table");
+ ("svg-fragment", `Fragment "svg");
+ ("math-fragment", `Fragment "math");
+ ]
+
+let check path html =
+ (* Adapt exactly once. Both parsers receive values derived from this list. *)
+ let tokens = Oracle.adapt html in
+ List.for_all
+ (fun (context_name, context) ->
+ List.for_all
+ (fun depth_limit ->
+ let suffix =
+ match depth_limit with
+ | None -> context_name
+ | Some n -> Printf.sprintf "%s/depth-%d" context_name n
+ in
+ let baseline =
+ run
+ (fun report ->
+ Oracle.parse_adapted ?depth_limit ~context report tokens)
+ (collect Markup.iter)
+ in
+ let lite =
+ run
+ (fun report ->
+ Oracle.parse_lite_adapted ?depth_limit ~context report tokens)
+ (collect Markup_lite.iter)
+ in
+ compare (path ^ ":" ^ suffix) baseline lite)
+ [ None; Some 1; Some 8 ])
+ contexts
+
+let () =
+ let directory =
+ match Array.to_list Sys.argv with
+ | [ _; directory ] -> directory
+ | _ -> usage Sys.argv.(0)
+ in
+ let files = html_files directory in
+ if files = [] then usage Sys.argv.(0);
+ let failures = ref 0 in
+ List.iteri
+ (fun index path ->
+ if not (check path (CCIO.File.read_exn (CCIO.File.make path))) then
+ incr failures;
+ if (index + 1) mod 100 = 0 then
+ Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files))
+ files;
+ Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files);
+ if !failures <> 0 then begin
+ Printf.eprintf "FAILED: %d files differed\n" !failures;
+ exit 1
+ end
diff --git a/test/lite/lite_writer_diff_corpus.ml b/test/lite/lite_writer_diff_corpus.ml
new file mode 100644
index 0000000..5be8d25
--- /dev/null
+++ b/test/lite/lite_writer_diff_corpus.ml
@@ -0,0 +1,187 @@
+let usage program =
+ Printf.eprintf "Usage: %s DIRECTORY\n" program;
+ exit 2
+
+let html_files directory =
+ let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in
+ let rec collect acc =
+ match files () with
+ | None -> List.sort String.compare acc
+ | Some path ->
+ let path = CCIO.File.to_string path in
+ collect
+ (if Filename.check_suffix path ".html" then path :: acc else acc)
+ in
+ collect []
+
+let collect stream =
+ let signals = ref [] in
+ Markup_lite.iter (fun signal -> signals := signal :: !signals) stream;
+ List.rev !signals
+
+type stats = {
+ mutable wall_seconds : float;
+ mutable minor_words : float;
+ mutable major_words : float;
+}
+
+let empty_stats () = { wall_seconds = 0.; minor_words = 0.; major_words = 0. }
+
+let measure stats f =
+ let gc_before = Gc.quick_stat () in
+ let wall_before = Unix.gettimeofday () in
+ let result = f () in
+ let wall_after = Unix.gettimeofday () in
+ let gc_after = Gc.quick_stat () in
+ stats.wall_seconds <- stats.wall_seconds +. wall_after -. wall_before;
+ stats.minor_words <-
+ stats.minor_words +. gc_after.minor_words -. gc_before.minor_words;
+ stats.major_words <-
+ stats.major_words +. gc_after.major_words -. gc_before.major_words;
+ result
+
+let write_with_markup signals =
+ signals |> Markup.of_list |> Markup.write_html |> Markup.to_string
+
+let write_with_lite signals =
+ let buffer = Buffer.create 4096 in
+ Markup_lite.write_html buffer (Markup.of_list signals);
+ Buffer.contents buffer
+
+let check_escape_regressions () =
+ let cases =
+ [
+ ("ASCII-safe", [ `Text [ "plain text" ] ]);
+ ("ASCII escapes", [ `Text [ "<&>" ] ]);
+ ( "attribute escapes",
+ [
+ `Start_element ((Markup.Ns.html, "p"), [ (("", "title"), "a&\"b") ]);
+ `End_element;
+ ] );
+ ("UTF-8 and non-breaking space", [ `Text [ "été\xC2\xA0東京" ] ]);
+ ("malformed UTF-8", [ `Text [ "before\xFFafter" ] ]);
+ ]
+ in
+ List.iter
+ (fun (name, signals) ->
+ let markup = write_with_markup signals in
+ let lite = write_with_lite signals in
+ if markup <> lite then begin
+ Printf.eprintf "%s escape regression:\n Markup: %S\n Lite: %S\n"
+ name markup lite;
+ exit 1
+ end)
+ cases
+
+let check_buffer_api () =
+ let wrap prefix buffer text =
+ Buffer.add_string buffer prefix;
+ Buffer.add_char buffer '(';
+ Buffer.add_string buffer text;
+ Buffer.add_char buffer ')'
+ in
+ let signals =
+ [
+ `Start_element ((Markup.Ns.html, "p"), [ (("", "id"), "x") ]);
+ `Text [ "y" ];
+ `End_element;
+ ]
+ in
+ let buffer = Buffer.create 64 in
+ Buffer.add_string buffer "prefix:";
+ Markup_lite.write_html ~escape_attribute:(wrap "A") ~escape_text:(wrap "T")
+ buffer (Markup.of_list signals);
+ Markup_lite.write_html buffer (Markup.of_list [ `Text [ "<&" ] ]);
+ let expected = "prefix:<p id=\"A(x)\">T(y)</p><&" in
+ if Buffer.contents buffer <> expected then begin
+ Printf.eprintf "buffer API check failed:\n expected: %S\n actual: %S\n"
+ expected (Buffer.contents buffer);
+ exit 1
+ end
+
+let difference left right =
+ let left_length = String.length left in
+ let right_length = String.length right in
+ let limit = min left_length right_length in
+ let rec find index =
+ if index = limit then index
+ else if left.[index] = right.[index] then find (index + 1)
+ else index
+ in
+ let index = find 0 in
+ let context string =
+ let start = max 0 (index - 24) in
+ let length = min (String.length string - start) 64 in
+ String.sub string start length
+ in
+ if index = limit then
+ Printf.sprintf
+ "output lengths differ at byte %d (Markup: %d, Lite: %d)\n\
+ \ Markup: %S\n\
+ \ Lite: %S"
+ index left_length right_length (context left) (context right)
+ else
+ Printf.sprintf
+ "output differs at byte %d (Markup: 0x%02X, Lite: 0x%02X)\n\
+ \ Markup: %S\n\
+ \ Lite: %S"
+ index
+ (Char.code left.[index])
+ (Char.code right.[index])
+ (context left) (context right)
+
+let () =
+ check_escape_regressions ();
+ check_buffer_api ();
+ let directory =
+ match Array.to_list Sys.argv with
+ | [ _; directory ] -> directory
+ | _ -> usage Sys.argv.(0)
+ in
+ let files = html_files directory in
+ if files = [] then begin
+ Printf.eprintf "No .html files found under: %s\n" directory;
+ exit 2
+ end;
+ let failures = ref 0 in
+ let markup_stats = empty_stats () in
+ let lite_stats = empty_stats () in
+ List.iteri
+ (fun index path ->
+ let html = CCIO.File.read_exn (CCIO.File.make path) in
+ let signals = collect (Markup_lite.parse_html html) in
+ let markup, lite =
+ if index mod 2 = 0 then begin
+ let markup =
+ measure markup_stats (fun () -> write_with_markup signals)
+ in
+ let lite = measure lite_stats (fun () -> write_with_lite signals) in
+ (markup, lite)
+ end
+ else begin
+ let lite = measure lite_stats (fun () -> write_with_lite signals) in
+ let markup =
+ measure markup_stats (fun () -> write_with_markup signals)
+ in
+ (markup, lite)
+ end
+ in
+ if markup <> lite then begin
+ incr failures;
+ Printf.eprintf "%s: %s\n" path (difference markup lite)
+ end;
+ if (index + 1) mod 100 = 0 then
+ Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files))
+ files;
+ Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files);
+ Printf.printf
+ "markup writer: wall_seconds=%.6f minor_words=%.0f major_words=%.0f\n\
+ lite writer: wall_seconds=%.6f minor_words=%.0f major_words=%.0f\n\
+ %!"
+ markup_stats.wall_seconds markup_stats.minor_words markup_stats.major_words
+ lite_stats.wall_seconds lite_stats.minor_words lite_stats.major_words;
+ if !failures <> 0 then begin
+ Printf.eprintf "FAILED: %d files differed\n" !failures;
+ exit 1
+ end;
+ Printf.printf "OK: %d HTML files serialized exactly\n%!" (List.length files)
diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml
new file mode 100644
index 0000000..affb885
--- /dev/null
+++ b/test/lite/oracle.ml
@@ -0,0 +1,95 @@
+module HS = Devkit.HtmlStream
+
+(* Raw-text tokenizer states substitute U+FFFD for U+0000. *)
+let raw_text text =
+ if String.contains text '\x00' then
+ String.concat "\xEF\xBF\xBD" (String.split_on_char '\x00' text)
+ else text
+
+let decode raw =
+ let inner = HS.Raw.project raw in
+ try Devkit.Web.htmldecode inner with _ -> inner
+
+(* See [htmlstream-adapter.md] for the common adaptation policy and its
+ test-only suitability assessment. HtmlStream does not expose comments,
+ self-closing syntax, raw-text token boundaries, or columns. The strict
+ parser oracle therefore omits comments, defaults [self_closing] to false,
+ expands Script/Style into three tokens, and uses [(line, -1)] for both
+ parsers. *)
+let adapt html : (Markup.location * Markup.Internals.token) list =
+ let ctx = HS.init () in
+ let tokens = ref [] in
+ let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in
+ let attributes attrs =
+ List.rev_map
+ (fun (name, value) -> (raw_text name, raw_text (decode value)))
+ attrs
+ in
+ let tag name attributes : Markup.Internals.Token_tag.t =
+ { name; attributes; self_closing = false }
+ in
+ (* Both tree builders assume tokenizers never leave U+0000 inside a
+ [`String]; split NULs out as [`Char 0] to preserve that invariant. *)
+ let emit_text text =
+ String.split_on_char '\x00' text
+ |> List.iteri (fun i part ->
+ if i > 0 then emit (`Char 0);
+ if part <> "" then emit (`String part))
+ in
+ let step = function
+ | HS.Text raw -> emit_text (decode raw)
+ | HS.Tag (name, attrs) -> emit (`Start (tag name (attributes attrs)))
+ | HS.Close "br" -> ()
+ | HS.Close name -> emit (`End (tag name []))
+ | HS.Script (attrs, text) ->
+ emit (`Start (tag "script" (attributes attrs)));
+ emit (`String (raw_text text));
+ emit (`End (tag "script" []))
+ | HS.Style (attrs, text) ->
+ emit (`Start (tag "style" (attributes attrs)));
+ emit (`String (raw_text text));
+ emit (`End (tag "style" []))
+ in
+ HS.parse ~ctx step html;
+ emit `EOF;
+ List.rev !tokens
+
+let lite_tokens tokens : (Markup_lite.location * Markup_lite.token) list =
+ let tag (tag : Markup.Internals.Token_tag.t) : Markup_lite.Token_tag.t =
+ {
+ name = tag.name;
+ attributes = tag.attributes;
+ self_closing = tag.self_closing;
+ }
+ in
+ List.map
+ (fun (location, token) ->
+ let token : Markup_lite.token =
+ match token with
+ | `Doctype d -> `Doctype d
+ | `Start t -> `Start (tag t)
+ | `End t -> `End (tag t)
+ | `Char c -> `Char c
+ | `String s -> `String s
+ | `Comment s -> `Comment s
+ | `EOF -> `EOF
+ in
+ (location, token))
+ tokens
+
+let parse_adapted ?depth_limit
+ ?(context : [ `Document | `Fragment of string ] = `Document) report tokens =
+ tokens
+ |> Markup.Internals.parse_tokens ?depth_limit ~report ~context
+ |> Markup.signals
+
+let parse_lite_adapted ?depth_limit
+ ?(context : [ `Document | `Fragment of string ] = `Document) report tokens =
+ tokens |> lite_tokens
+ |> Markup_lite.parse_tokens ?depth_limit ~report ~context
+
+let parse ?depth_limit
+ ?(context : [ `Document | `Fragment of string ] = `Document) report html =
+ Markup.string html
+ |> Markup.parse_html ~report ~context ?depth_limit
+ |> Markup.signals
diff --git a/test/ragel_html_tokenizer.ml b/test/ragel_html_tokenizer.ml
new file mode 100644
index 0000000..d2ef737
--- /dev/null
+++ b/test/ragel_html_tokenizer.ml
@@ -0,0 +1,44 @@
+(* This file is part of Markup.ml, released under the MIT license. See
+ LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *)
+
+open Markup__Common
+
+module HS = Devkit.HtmlStream
+
+let decode raw =
+ let inner = HS.Raw.project raw in
+ try Devkit.Web.htmldecode inner with _ -> inner
+
+let tokenize html : (location * Markup__Html_tokenizer.token) list =
+ let ctx = HS.init () in
+ let tokens = ref [] in
+ let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in
+ let attributes attrs =
+ List.rev_map (fun (name, value) -> name, decode value) attrs
+ in
+ let tag name attributes =
+ {Token_tag.name; attributes; self_closing = false}
+ in
+ let step = function
+ | HS.Text raw ->
+ emit (`String (decode raw))
+ | HS.Tag (name, attrs) ->
+ emit (`Start (tag name (attributes attrs)))
+ | HS.Close "br" ->
+ (* [HtmlStream] emits both [Tag "br"] and [Close "br"] for [<br/>].
+ Feeding the close token to the tree builder creates a second [br]. *)
+ ()
+ | HS.Close name ->
+ emit (`End (tag name []))
+ | HS.Script (attrs, text) ->
+ emit (`Start (tag "script" (attributes attrs)));
+ emit (`String text);
+ emit (`End (tag "script" []))
+ | HS.Style (attrs, text) ->
+ emit (`Start (tag "style" (attributes attrs)));
+ emit (`String text);
+ emit (`End (tag "style" []))
+ in
+ HS.parse ~ctx step html;
+ emit `EOF;
+ List.rev !tokens
diff --git a/test/test.ml b/test/test.ml
index 8cace4f..7e20574 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -21,8 +21,7 @@ let suite =
Test_detect.tests;
Test_utility.tests;
Test_integration.tests;
- (* Test_ragel_tokenizer.tests; *)
- (* Test_ragel_parser.tests; *)
+ Test_ragel_tokenizer.tests;
]
let () =
diff --git a/test/test_ragel_parser.ml b/test/test_ragel_parser.ml
deleted file mode 100644
index b6438ef..0000000
--- a/test/test_ragel_parser.ml
+++ /dev/null
@@ -1,1716 +0,0 @@
-open OUnit2
-open Test_support
-open Markup__Common
-module Error = Markup__Error
-module Kstream = Markup__Kstream
-
-let print_token_stream stream =
- let print_token (_, token) _throw k =
- print_endline @@ String.escaped @@ token_to_string token;
- k ()
- in
- print_endline "tokens:";
- Kstream.iter print_token stream (wrong_k "failed") ignore
-
-let print_signal_stream stream =
- let print_token (_, token) _throw k =
- print_endline @@ String.escaped @@ signal_to_string token;
- k ()
- in
- print_endline "tokens:";
- Kstream.iter print_token stream (wrong_k "failed") ignore
-
-let doctype =
- `Doctype
- {
- doctype_name = Some "html";
- public_identifier = None;
- system_identifier = None;
- raw_text = None;
- force_quirks = false;
- }
-
-let start_element name = `Start_element ((html_ns, name), [])
-
-let expect ?prefix ?(context = Some `Document) text signals =
- (* ragel parser doesn't emit bad token Error, filter them out *)
- let signals =
- List.filter (function
- | _, _, E (`Bad_token _) | _, _, E (`Bad_document "doctype should be first")
- -> false
- | _ -> true) signals
- in
-
- let report, iterate, ended =
- expect_no_location_signals ?prefix signal_to_string text signals
- in
-
- let token_stream = Markup__Html_tokenizer.Ragel.tokenize text in
-
- let signal_stream =
- Markup__Html_parser.parse context report (token_stream, ignore, ignore)
- in
- (* print_signal_stream signal_stream; *)
- iter iterate signal_stream;
- ended ()
-
-let tests =
- [
- ( "html.parser.basic" >:: fun _ ->
- expect "<!DOCTYPE html><html><head></head><body></body></html>"
- [
- (1, 1, S doctype);
- (1, 16, S (start_element "html"));
- (1, 22, S (start_element "head"));
- (1, 28, S `End_element);
- (1, 35, S (start_element "body"));
- (1, 55, S `End_element);
- (1, 55, S `End_element);
- ];
-
- expect ~prefix:true " <!--foo--> <!DOCTYPE html>"
- [ (1, 2, S (`Comment "foo")); (1, 13, S doctype) ];
-
- expect ~prefix:true "<!DOCTYPE html> <!--foo--> <html></html>"
- [
- (1, 1, S doctype);
- (1, 17, S (`Comment "foo"));
- (1, 28, S (start_element "html"));
- ];
-
- expect ~prefix:true "<html> <!--foo--> <head></head></html>"
- [
- (1, 1, S (start_element "html"));
- (1, 8, S (`Comment "foo"));
- (1, 19, S (start_element "head"));
- ] );
- ( "html.parser.implicit-top-level" >:: fun _ ->
- expect "<!DOCTYPE html>"
- [
- (1, 1, S doctype);
- (1, 16, S (start_element "html"));
- (1, 16, S (start_element "head"));
- (1, 16, S `End_element);
- (1, 16, S (start_element "body"));
- (1, 16, S `End_element);
- (1, 16, S `End_element);
- ];
-
- expect "<!DOCTYPE html><html></html>"
- [
- (1, 1, S doctype);
- (1, 16, S (start_element "html"));
- (1, 22, S (start_element "head"));
- (1, 22, S `End_element);
- (1, 22, S (start_element "body"));
- (1, 29, S `End_element);
- (1, 29, S `End_element);
- ];
-
- expect "<!DOCTYPE html><head></head>"
- [
- (1, 1, S doctype);
- (1, 16, S (start_element "html"));
- (1, 16, S (start_element "head"));
- (1, 22, S `End_element);
- (1, 29, S (start_element "body"));
- (1, 29, S `End_element);
- (1, 29, S `End_element);
- ];
-
- expect "<!DOCTYPE html><body></body>"
- [
- (1, 1, S doctype);
- (1, 16, S (start_element "html"));
- (1, 16, S (start_element "head"));
- (1, 16, S `End_element);
- (1, 16, S (start_element "body"));
- (1, 29, S `End_element);
- (1, 29, S `End_element);
- ];
-
- expect "<!DOCTYPE html><p></p>"
- [
- (1, 1, S doctype);
- (1, 16, S (start_element "html"));
- (1, 16, S (start_element "head"));
- (1, 16, S `End_element);
- (1, 16, S (start_element "body"));
- (1, 16, S (start_element "p"));
- (1, 19, S `End_element);
- (1, 23, S `End_element);
- (1, 23, S `End_element);
- ];
-
- expect "<!DOCTYPE html><title></title>"
- [
- (1, 1, S doctype);
- (1, 16, S (start_element "html"));
- (1, 16, S (start_element "head"));
- (1, 16, S (start_element "title"));
- (1, 23, S `End_element);
- (1, 31, S `End_element);
- (1, 31, S (start_element "body"));
- (1, 31, S `End_element);
- (1, 31, S `End_element);
- ] );
- ( "html.parser.no-doctype" >:: fun _ ->
- expect ~prefix:true "<title>foo</title>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S (start_element "title"));
- (1, 8, S (`Text [ "foo" ]));
- ] );
- ( "html.parser.double-doctype" >:: fun _ ->
- expect ~prefix:true "<!DOCTYPE html><!DOCTYPE html><html></html>"
- [
- (1, 1, S doctype);
- (1, 16, E (`Bad_document "doctype should be first"));
- (1, 31, S (start_element "html"));
- ] );
- ( "html.parser.end-before-html" >:: fun _ ->
- expect ~prefix:true "</p><html></html>"
- [ (1, 1, E (`Unmatched_end_tag "p")); (1, 5, S (start_element "html")) ]
- );
- ( "html.parser.junk-before-head" >:: fun _ ->
- expect ~prefix:true "<html><!DOCTYPE html><html></p><head></head></html>"
- [
- (1, 1, S (start_element "html"));
- (1, 7, E (`Bad_document "doctype should be first"));
- (1, 22, E (`Misnested_tag ("html", "html", [])));
- (1, 28, E (`Unmatched_end_tag "p"));
- (1, 32, S (start_element "head"));
- ] );
- ( "html.parser.head" >:: fun _ ->
- expect ~prefix:true "<head> <!--foo--><link><link/><meta><meta/></head>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 7, S (`Text [ " " ]));
- (1, 8, S (`Comment "foo"));
- (1, 18, S (start_element "link"));
- (1, 18, S `End_element);
- (1, 24, S (start_element "link"));
- (1, 24, S `End_element);
- (1, 31, S (start_element "meta"));
- (1, 31, S `End_element);
- (1, 37, S (start_element "meta"));
- (1, 37, S `End_element);
- (1, 44, S `End_element);
- (1, 51, S (start_element "body"));
- ] );
- ( "html.parser.style" >:: fun _ ->
- expect ~prefix:true "<head><style>foo</head><</style></head>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 7, S (start_element "style"));
- (1, 14, S (`Text [ "foo</head><" ]));
- (1, 28, S `End_element);
- (1, 36, S `End_element);
- (1, 43, S (start_element "body"));
- ] );
- ( "html.parser.title" >:: fun _ ->
- expect ~prefix:true "<head><title>foo</head><</title></head>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 7, S (start_element "title"));
- (1, 14, S (`Text [ "foo</head><" ]));
- (1, 28, S `End_element);
- (1, 36, S `End_element);
- (1, 43, S (start_element "body"));
- ] );
- ( "html.parser.script" >:: fun _ ->
- expect ~prefix:true "<head><script><!--foo</head><bar</script></head>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 7, S (start_element "script"));
- (1, 15, S (`Text [ "<!--foo</head><bar" ]));
- (1, 36, S `End_element);
- (1, 45, S `End_element);
- (1, 52, S (start_element "body"));
- ] );
- ( "html.parser.junk-in-head" >:: fun _ ->
- expect ~prefix:true "<head><!DOCTYPE html><html><head></p></head>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 7, E (`Bad_document "doctype should be first"));
- (1, 22, E (`Misnested_tag ("html", "head", [])));
- (1, 28, E (`Misnested_tag ("head", "head", [])));
- (1, 34, E (`Unmatched_end_tag "p"));
- (1, 38, S `End_element);
- (1, 45, S (start_element "body"));
- ] );
- ( "html.parser.junk-after-head" >:: fun _ ->
- expect ~prefix:true
- "<head></head> <!--foo--><!DOCTYPE html><html><meta><head></p><body>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 7, S `End_element);
- (1, 14, S (`Text [ " " ]));
- (1, 15, S (`Comment "foo"));
- (1, 25, E (`Bad_document "doctype should be first"));
- (1, 40, E (`Misnested_tag ("html", "html", [])));
- (1, 46, E (`Misnested_tag ("meta", "html", [])));
- (1, 46, S (start_element "meta"));
- (1, 46, S `End_element);
- (1, 52, E (`Bad_document "duplicate head element"));
- (1, 58, E (`Unmatched_end_tag "p"));
- (1, 62, S (start_element "body"));
- ] );
- ( "html.parser.whitespace-after-head" >:: fun _ ->
- expect "<html><head></head> </html>"
- [
- (1, 1, S (start_element "html"));
- (1, 7, S (start_element "head"));
- (1, 13, S `End_element);
- (1, 20, S (`Text [ " " ]));
- (1, 21, S (start_element "body"));
- (1, 28, S `End_element);
- (1, 28, S `End_element);
- ];
-
- expect "<html><head><title>foo</title></head> </html>"
- [
- (1, 1, S (start_element "html"));
- (1, 7, S (start_element "head"));
- (1, 13, S (start_element "title"));
- (1, 20, S (`Text [ "foo" ]));
- (1, 23, S `End_element);
- (1, 31, S `End_element);
- (1, 38, S (`Text [ " " ]));
- (1, 39, S (start_element "body"));
- (1, 46, S `End_element);
- (1, 46, S `End_element);
- ] );
- ( "html.parser.body-content" >:: fun _ ->
- expect "<body><!--foo--> bar</body>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 7, S (`Comment "foo"));
- (1, 17, S (`Text [ " bar" ]));
- (1, 28, S `End_element);
- (1, 28, S `End_element);
- ] );
- ( "html.parser.body.whitespace" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- " \n\r\t\x0c
"
- [ (1, 1, S (`Text [ " \n\n\t\x0c\r" ])) ] );
- ( "html.parser.paragraphs" >:: fun _ ->
- expect "<p>foo</p>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S (`Text [ "foo" ]));
- (1, 7, S `End_element);
- (1, 11, S `End_element);
- (1, 11, S `End_element);
- ];
-
- expect "<p>foo<p>bar<div>baz</div>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S (`Text [ "foo" ]));
- (1, 7, S `End_element);
- (1, 7, S (start_element "p"));
- (1, 10, S (`Text [ "bar" ]));
- (1, 13, S `End_element);
- (1, 13, S (start_element "div"));
- (1, 18, S (`Text [ "baz" ]));
- (1, 21, S `End_element);
- (1, 27, S `End_element);
- (1, 27, S `End_element);
- ] );
- ( "html.parser.p.autoclose" >:: fun _ ->
- expect
- ("<p><address></address><p><article></article><p><aside></aside>\n"
- ^ "<p><blockquote></blockquote><p><center></center>\n"
- ^ "<p><details></details><p><dialog></dialog><p><dir></dir>\n"
- ^ "<p><div></div><p><dl></dl><p><fieldset></fieldset>\n"
- ^ "<p><figcaption></figcaption><p><figure></figure>\n"
- ^ "<p><footer></footer><p><header></header><p><hgroup></hgroup>\n"
- ^ "<p><main></main><p><nav></nav><p><ol></ol><p><p></p>\n"
- ^ "<p><section></section><p><summary></summary><p><ul></ul>\n"
- ^ "<p><h1></h1><p><h2></h2><p><h3></h3><p><h4></h4><p><h5></h5>\n"
- ^ "<p><h6></h6>")
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "address"));
- (1, 13, S `End_element);
- (1, 23, S (start_element "p"));
- (1, 26, S `End_element);
- (1, 26, S (start_element "article"));
- (1, 35, S `End_element);
- (1, 45, S (start_element "p"));
- (1, 48, S `End_element);
- (1, 48, S (start_element "aside"));
- (1, 55, S `End_element);
- (1, 63, S (`Text [ "\n" ]));
- (2, 1, S (start_element "p"));
- (2, 4, S `End_element);
- (2, 4, S (start_element "blockquote"));
- (2, 16, S `End_element);
- (2, 29, S (start_element "p"));
- (2, 32, S `End_element);
- (2, 32, S (start_element "center"));
- (2, 40, S `End_element);
- (2, 49, S (`Text [ "\n" ]));
- (3, 1, S (start_element "p"));
- (3, 4, S `End_element);
- (3, 4, S (start_element "details"));
- (3, 13, S `End_element);
- (3, 23, S (start_element "p"));
- (3, 26, S `End_element);
- (3, 26, S (start_element "dialog"));
- (3, 34, S `End_element);
- (3, 43, S (start_element "p"));
- (3, 46, S `End_element);
- (3, 46, S (start_element "dir"));
- (3, 51, S `End_element);
- (3, 57, S (`Text [ "\n" ]));
- (4, 1, S (start_element "p"));
- (4, 4, S `End_element);
- (4, 4, S (start_element "div"));
- (4, 9, S `End_element);
- (4, 15, S (start_element "p"));
- (4, 18, S `End_element);
- (4, 18, S (start_element "dl"));
- (4, 22, S `End_element);
- (4, 27, S (start_element "p"));
- (4, 30, S `End_element);
- (4, 30, S (start_element "fieldset"));
- (4, 40, S `End_element);
- (4, 51, S (`Text [ "\n" ]));
- (5, 1, S (start_element "p"));
- (5, 4, S `End_element);
- (5, 4, S (start_element "figcaption"));
- (5, 16, S `End_element);
- (5, 29, S (start_element "p"));
- (5, 32, S `End_element);
- (5, 32, S (start_element "figure"));
- (5, 40, S `End_element);
- (5, 49, S (`Text [ "\n" ]));
- (6, 1, S (start_element "p"));
- (6, 4, S `End_element);
- (6, 4, S (start_element "footer"));
- (6, 12, S `End_element);
- (6, 21, S (start_element "p"));
- (6, 24, S `End_element);
- (6, 24, S (start_element "header"));
- (6, 32, S `End_element);
- (6, 41, S (start_element "p"));
- (6, 44, S `End_element);
- (6, 44, S (start_element "hgroup"));
- (6, 52, S `End_element);
- (6, 61, S (`Text [ "\n" ]));
- (7, 1, S (start_element "p"));
- (7, 4, S `End_element);
- (7, 4, S (start_element "main"));
- (7, 10, S `End_element);
- (7, 17, S (start_element "p"));
- (7, 20, S `End_element);
- (7, 20, S (start_element "nav"));
- (7, 25, S `End_element);
- (7, 31, S (start_element "p"));
- (7, 34, S `End_element);
- (7, 34, S (start_element "ol"));
- (7, 38, S `End_element);
- (7, 43, S (start_element "p"));
- (7, 46, S `End_element);
- (7, 46, S (start_element "p"));
- (7, 49, S `End_element);
- (7, 53, S (`Text [ "\n" ]));
- (8, 1, S (start_element "p"));
- (8, 4, S `End_element);
- (8, 4, S (start_element "section"));
- (8, 13, S `End_element);
- (8, 23, S (start_element "p"));
- (8, 26, S `End_element);
- (8, 26, S (start_element "summary"));
- (8, 35, S `End_element);
- (8, 45, S (start_element "p"));
- (8, 48, S `End_element);
- (8, 48, S (start_element "ul"));
- (8, 52, S `End_element);
- (8, 57, S (`Text [ "\n" ]));
- (9, 1, S (start_element "p"));
- (9, 4, S `End_element);
- (9, 4, S (start_element "h1"));
- (9, 8, S `End_element);
- (9, 13, S (start_element "p"));
- (9, 16, S `End_element);
- (9, 16, S (start_element "h2"));
- (9, 20, S `End_element);
- (9, 25, S (start_element "p"));
- (9, 28, S `End_element);
- (9, 28, S (start_element "h3"));
- (9, 32, S `End_element);
- (9, 37, S (start_element "p"));
- (9, 40, S `End_element);
- (9, 40, S (start_element "h4"));
- (9, 44, S `End_element);
- (9, 49, S (start_element "p"));
- (9, 52, S `End_element);
- (9, 52, S (start_element "h5"));
- (9, 56, S `End_element);
- (9, 61, S (`Text [ "\n" ]));
- (10, 1, S (start_element "p"));
- (10, 4, S `End_element);
- (10, 4, S (start_element "h6"));
- (10, 8, S `End_element);
- (10, 13, S `End_element);
- (10, 13, S `End_element);
- ] );
- ( "html.parser.attributes" >:: fun _ ->
- expect "<div :class='foo'></div>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- ( 1,
- 1,
- S (`Start_element ((html_ns, "div"), [ (("", ":class"), "foo") ]))
- );
- (1, 19, S `End_element);
- (1, 25, S `End_element);
- (1, 25, S `End_element);
- ] );
- ( "html.parser.links" >:: fun _ ->
- expect {|<a href="foo.com?bar=on&acte=123">foo</a>|}
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- ( 1,
- 1,
- S
- (`Start_element
- ((html_ns, "a"), [ (("", "href"), "foo.com?bar=on&acte=123") ]))
- );
- (1, 35, S (`Text [ "foo" ]));
- (1, 38, S `End_element);
- (1, 42, S `End_element);
- (1, 42, S `End_element);
- ];
-
- expect {|<a href="foo.com?bar=on&image=on">foo</a>|}
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- ( 1,
- 1,
- S
- (`Start_element
- ((html_ns, "a"), [ (("", "href"), "foo.com?bar=on&image=on") ]))
- );
- (1, 35, S (`Text [ "foo" ]));
- (1, 38, S `End_element);
- (1, 42, S `End_element);
- (1, 42, S `End_element);
- ];
-
- expect {|<a href="foo.com?bar=onℑ">foo</a>|}
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- ( 1,
- 1,
- S
- (`Start_element
- ((html_ns, "a"), [ (("", "href"), "foo.com?bar=onâ„‘") ])) );
- (1, 33, S (`Text [ "foo" ]));
- (1, 36, S `End_element);
- (1, 40, S `End_element);
- (1, 40, S `End_element);
- ] );
- ( "html.parser.headings" >:: fun _ ->
- expect "<h1><h2><h3><h4><h5><h6><h1>foo</h1>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "h1"));
- (1, 5, E (`Misnested_tag ("h2", "h1", [])));
- (1, 5, S `End_element);
- (1, 5, S (start_element "h2"));
- (1, 9, E (`Misnested_tag ("h3", "h2", [])));
- (1, 9, S `End_element);
- (1, 9, S (start_element "h3"));
- (1, 13, E (`Misnested_tag ("h4", "h3", [])));
- (1, 13, S `End_element);
- (1, 13, S (start_element "h4"));
- (1, 17, E (`Misnested_tag ("h5", "h4", [])));
- (1, 17, S `End_element);
- (1, 17, S (start_element "h5"));
- (1, 21, E (`Misnested_tag ("h6", "h5", [])));
- (1, 21, S `End_element);
- (1, 21, S (start_element "h6"));
- (1, 25, E (`Misnested_tag ("h1", "h6", [])));
- (1, 25, S `End_element);
- (1, 25, S (start_element "h1"));
- (1, 29, S (`Text [ "foo" ]));
- (1, 32, S `End_element);
- (1, 37, S `End_element);
- (1, 37, S `End_element);
- ] );
- ( "html.parser.pre" >:: fun _ ->
- expect "<p><pre>foo</pre>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "pre"));
- (1, 9, S (`Text [ "foo" ]));
- (1, 12, S `End_element);
- (1, 18, S `End_element);
- (1, 18, S `End_element);
- ];
-
- expect "<p><pre>\n\nfoo</pre>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "pre"));
- (2, 1, S (`Text [ "\nfoo" ]));
- (3, 4, S `End_element);
- (3, 10, S `End_element);
- (3, 10, S `End_element);
- ] );
- ( "html.parser.listing.leading-newline" >:: fun _ ->
- expect "<listing>\n\nfoo</listing>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "listing"));
- (2, 1, S (`Text [ "\nfoo" ]));
- (3, 4, S `End_element);
- (3, 14, S `End_element);
- (3, 14, S `End_element);
- ] );
- ( "html.parser.textarea" >:: fun _ ->
- expect "<textarea>foo</p></textarea>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "textarea"));
- (1, 11, S (`Text [ "foo</p>" ]));
- (1, 18, S `End_element);
- (1, 29, S `End_element);
- (1, 29, S `End_element);
- ];
-
- expect "<textarea>\n\nfoo</p></textarea>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "textarea"));
- (2, 1, S (`Text [ "\nfoo</p>" ]));
- (3, 8, S `End_element);
- (3, 19, S `End_element);
- (3, 19, S `End_element);
- ];
-
- expect
- ~context:(Some (`Fragment "body"))
- "<textarea></textarea><p>foo</p>"
- [
- (1, 1, S (start_element "textarea"));
- (1, 11, S `End_element);
- (1, 22, S (start_element "p"));
- (1, 25, S (`Text [ "foo" ]));
- (1, 28, S `End_element);
- ] );
- ( "html.parser.list" >:: fun _ ->
- expect "<ul><li>foo<li>bar</ul>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "ul"));
- (1, 5, S (start_element "li"));
- (1, 9, S (`Text [ "foo" ]));
- (1, 12, S `End_element);
- (1, 12, S (start_element "li"));
- (1, 16, S (`Text [ "bar" ]));
- (1, 19, S `End_element);
- (1, 19, S `End_element);
- (1, 24, S `End_element);
- (1, 24, S `End_element);
- ] );
- ( "html.parser.definition" >:: fun _ ->
- expect "<p><dt>foo<dd>bar"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "dt"));
- (1, 8, S (`Text [ "foo" ]));
- (1, 11, S `End_element);
- (1, 11, S (start_element "dd"));
- (1, 15, S (`Text [ "bar" ]));
- (1, 18, S `End_element);
- (1, 18, S `End_element);
- (1, 18, S `End_element);
- ] );
- ( "html.parser.plaintext" >:: fun _ ->
- expect "<p><plaintext>foo</plaintext></p>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "plaintext"));
- (1, 4, E (`Unmatched_start_tag "plaintext"));
- (1, 15, S (`Text [ "foo</plaintext></p>" ]));
- (1, 34, S `End_element);
- (1, 34, S `End_element);
- (1, 34, S `End_element);
- ] );
- ( "html.parser.table" >:: fun _ ->
- expect "<p><table><tr><td>foo</td><td>bar</td></tr></table>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "table"));
- (1, 11, S (start_element "tbody"));
- (1, 11, S (start_element "tr"));
- (1, 15, S (start_element "td"));
- (1, 19, S (`Text [ "foo" ]));
- (1, 22, S `End_element);
- (1, 27, S (start_element "td"));
- (1, 31, S (`Text [ "bar" ]));
- (1, 34, S `End_element);
- (1, 39, S `End_element);
- (1, 44, S `End_element);
- (1, 44, S `End_element);
- (1, 52, S `End_element);
- (1, 52, S `End_element);
- ] );
- ( "html.parser.select" >:: fun _ ->
- expect "<select><option>foo<option>bar</select>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "select"));
- (1, 9, S (start_element "option"));
- (1, 17, S (`Text [ "foo" ]));
- (1, 20, S `End_element);
- (1, 20, S (start_element "option"));
- (1, 28, S (`Text [ "bar" ]));
- (1, 31, S `End_element);
- (1, 31, S `End_element);
- (1, 40, S `End_element);
- (1, 40, S `End_element);
- ] );
- ( "html.parser.datalist" >:: fun _ ->
- expect "<datalist><option><option></datalist>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "datalist"));
- (1, 11, S (start_element "option"));
- (1, 19, S `End_element);
- (1, 19, S (start_element "option"));
- (1, 27, S `End_element);
- (1, 27, S `End_element);
- (1, 38, S `End_element);
- (1, 38, S `End_element);
- ] );
- ( "html.parser.datalist.whitespace" >:: fun _ ->
- expect "<datalist>\n<option>\n<option>\n</datalist>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "datalist"));
- (1, 11, S (`Text [ "\n" ]));
- (2, 1, S (start_element "option"));
- (2, 9, S (`Text [ "\n" ]));
- (3, 1, S `End_element);
- (3, 1, S (start_element "option"));
- (3, 9, S (`Text [ "\n" ]));
- (4, 1, S `End_element);
- (4, 1, S `End_element);
- (4, 12, S `End_element);
- (4, 12, S `End_element);
- ] );
- ( "html.parser.ruby" >:: fun _ ->
- expect "<rb>a<rt>b"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, E (`Misnested_tag ("rb", "body", [])));
- (1, 1, S (start_element "rb"));
- (1, 6, E (`Misnested_tag ("rt", "body", [])));
- (1, 5, S (`Text [ "a" ]));
- (1, 6, S (start_element "rt"));
- (1, 6, E (`Unmatched_start_tag "rt"));
- (1, 1, E (`Unmatched_start_tag "rb"));
- (1, 10, S (`Text [ "b" ]));
- (1, 11, S `End_element);
- (1, 11, S `End_element);
- (1, 11, S `End_element);
- (1, 11, S `End_element);
- ] );
- ( "html.parser.truncated-body" >:: fun _ ->
- expect "<body>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 7, S `End_element);
- (1, 7, S `End_element);
- ];
-
- expect "<body></html>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 14, S `End_element);
- (1, 14, S `End_element);
- ] );
- ( "html.parser.junk-in-body" >:: fun _ ->
- expect "<body>\x00<!DOCTYPE html><html><meta><body attr='value'></body>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 7, E (`Bad_token ("U+0000", "body", "null")));
- (1, 8, E (`Bad_document "doctype should be first"));
- (1, 23, E (`Misnested_tag ("html", "body", [])));
- (1, 29, S (start_element "meta"));
- (1, 29, S `End_element);
- (1, 35, E (`Misnested_tag ("body", "body", [ ("attr", "value") ])));
- (1, 61, S `End_element);
- (1, 61, S `End_element);
- ] );
- ( "html.parser.nested-html-in-body" >:: fun _ ->
- expect "<div><html></html>foo</div><div>bar</div>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "div"));
- (1, 6, E (`Misnested_tag ("html", "body", [])));
- (1, 1, E (`Unmatched_start_tag "div"));
- (1, 19, E (`Bad_content "html"));
- (1, 19, S (`Text [ "foo" ]));
- (1, 22, S `End_element);
- (1, 28, S (start_element "div"));
- (1, 33, S (`Text [ "bar" ]));
- (1, 36, S `End_element);
- (1, 42, S `End_element);
- (1, 42, S `End_element);
- ] );
- ( "html.parser.nested-html-with-body-in-body" >:: fun _ ->
- expect "<p><html><body><p></body><br><p>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, E (`Misnested_tag ("html", "body", [])));
- (1, 10, E (`Misnested_tag ("body", "body", [])));
- (1, 16, S `End_element);
- (1, 16, S (start_element "p"));
- (1, 26, E (`Bad_document "content after body"));
- (1, 26, S (start_element "br"));
- (1, 26, S `End_element);
- (1, 30, S `End_element);
- (1, 30, S (start_element "p"));
- (1, 33, S `End_element);
- (1, 33, S `End_element);
- (1, 33, S `End_element);
- ] );
- ( "html.parser.whitespace-at-end" >:: fun _ ->
- expect "<html><body></body></html> "
- [
- (1, 1, S (start_element "html"));
- (1, 7, S (start_element "head"));
- (1, 7, S `End_element);
- (1, 7, S (start_element "body"));
- (1, 27, S (`Text [ " " ]));
- (1, 28, S `End_element);
- (1, 28, S `End_element);
- ] );
- ( "html.parser.foreign" >:: fun _ ->
- expect "<body><svg><g/></svg></body>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 7, S (`Start_element ((svg_ns, "svg"), [])));
- (1, 12, S (`Start_element ((svg_ns, "g"), [])));
- (1, 12, S `End_element);
- (1, 16, S `End_element);
- (1, 29, S `End_element);
- (1, 29, S `End_element);
- ] );
- ( "html.parser.foreign.attribute" >:: fun _ ->
- expect "<body><svg refX=\"\"><g/></svg></body>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 7, S (`Start_element ((svg_ns, "svg"), [ (("", "refX"), "") ])));
- (1, 20, S (`Start_element ((svg_ns, "g"), [])));
- (1, 20, S `End_element);
- (1, 24, S `End_element);
- (1, 37, S `End_element);
- (1, 37, S `End_element);
- ] );
- ( "html.parser.foreign.svg-followed-by-html" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<svg><feTile></feTile></svg><b></b>"
- [
- (1, 1, S (`Start_element ((svg_ns, "svg"), [])));
- (1, 6, S (`Start_element ((svg_ns, "feTile"), [])));
- (1, 14, S `End_element);
- (1, 23, S `End_element);
- (1, 29, S (start_element "b"));
- (1, 32, S `End_element);
- ] );
- ( "html.parser.reconstruct-active-formatting-elements" >:: fun _ ->
- expect "<p><em><strong>foo<p>bar"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 8, E (`Unmatched_start_tag "strong"));
- (1, 4, S (start_element "em"));
- (1, 8, S (start_element "strong"));
- (1, 16, S (`Text [ "foo" ]));
- (1, 19, S `End_element);
- (1, 19, S `End_element);
- (1, 19, S `End_element);
- (1, 19, S (start_element "p"));
- (1, 8, E (`Unmatched_start_tag "strong"));
- (1, 4, E (`Unmatched_start_tag "em"));
- (1, 4, S (start_element "em"));
- (1, 8, S (start_element "strong"));
- (1, 22, S (`Text [ "bar" ]));
- (1, 25, S `End_element);
- (1, 25, S `End_element);
- (1, 25, S `End_element);
- (1, 25, S `End_element);
- (1, 25, S `End_element);
- ] );
- ( "html.parser.close-formatting-elements" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<a>fo</a>o"
- [
- (1, 1, S (start_element "a"));
- (1, 4, S (`Text [ "fo" ]));
- (1, 6, S `End_element);
- (1, 10, S (`Text [ "o" ]));
- ] );
- ( "html.parser.reset-mode" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<table></table><table></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S `End_element);
- (1, 16, S (start_element "table"));
- (1, 23, S `End_element);
- ] );
- ( "html.parser.fragment" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "title"))
- "</p>"
- [ (1, 1, S (`Text [ "</p>" ])) ];
-
- expect
- ~context:(Some (`Fragment "textarea"))
- "</p>"
- [ (1, 1, S (`Text [ "</p>" ])) ];
-
- expect
- ~context:(Some (`Fragment "body"))
- "</p>"
- [
- (1, 1, E (`Unmatched_end_tag "p"));
- (1, 1, S (start_element "p"));
- (1, 1, S `End_element);
- ];
-
- expect
- ~context:(Some (`Fragment "body"))
- "<!DOCTYPE html>"
- [ (1, 1, E (`Bad_document "doctype should be first")) ] );
- ( "html.parser.fragment.rawtext" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "style"))
- " </p>"
- [ (1, 1, S (`Text [ " </p>" ])) ] );
- ( "html.parser.fragment.script" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "script"))
- " </p>"
- [ (1, 1, S (`Text [ " </p>" ])) ] );
- ( "html.parser.fragment.plaintext" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "plaintext"))
- " </p></plaintext>"
- [ (1, 1, S (`Text [ " </p></plaintext>" ])) ] );
- ( "html.parser.context-detection" >:: fun _ ->
- expect ~context:None "<p>foo</p>"
- [
- (1, 1, S (start_element "p"));
- (1, 4, S (`Text [ "foo" ]));
- (1, 7, S `End_element);
- ];
-
- expect ~context:None "<html></html>"
- [
- (1, 1, S (start_element "html"));
- (1, 7, S (start_element "head"));
- (1, 7, S `End_element);
- (1, 7, S (start_element "body"));
- (1, 14, S `End_element);
- (1, 14, S `End_element);
- ] );
- ( "html.parser.foreign-context" >:: fun _ ->
- expect ~context:None "<g/>"
- [
- (1, 1, S (`Start_element ((svg_ns, "g"), []))); (1, 1, S `End_element);
- ] );
- ( "html.parser.context-disambiguation" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "svg"))
- "<a></a>"
- [
- (1, 1, S (`Start_element ((svg_ns, "a"), []))); (1, 4, S `End_element);
- ] );
- ( "html.parser.context-case-insensitivity" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "SVG"))
- "<a></a>"
- [
- (1, 1, S (`Start_element ((svg_ns, "a"), []))); (1, 4, S `End_element);
- ] );
- ( "html.parser.bad-self-closing-tag" >:: fun _ ->
- expect "<p/>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, E (`Bad_token ("/>", "tag", "should not be self-closing")));
- (1, 1, S (start_element "p"));
- (1, 5, S `End_element);
- (1, 5, S `End_element);
- (1, 5, S `End_element);
- ] );
- ( "html.parser.image-tag" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<image/>"
- [
- (1, 1, E (`Bad_token ("image", "tag", "should be 'img'")));
- (1, 1, S (start_element "img"));
- (1, 1, S `End_element);
- ] );
- ( "html.parser.nulls" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "svg"))
- "\x00foo"
- [
- (1, 1, E (`Bad_token ("U+0000", "foreign content", "null")));
- (1, 1, S (`Text [ "\xef\xbf\xbdfoo" ]));
- ];
-
- expect
- ~context:(Some (`Fragment "body"))
- "<table>\x00foo</table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, E (`Bad_token ("U+0000", "table", "null")));
- (1, 9, E (`Bad_content "table"));
- (1, 10, E (`Bad_content "table"));
- (1, 11, E (`Bad_content "table"));
- (1, 9, S (`Text [ "foo" ]));
- (1, 12, S `End_element);
- ];
-
- expect
- ~context:(Some (`Fragment "select"))
- "\x00foo"
- [
- (1, 1, E (`Bad_token ("U+0000", "select", "null")));
- (1, 2, S (`Text [ "foo" ]));
- ] );
- ( "html.parser.foreign.cdata" >:: fun _ ->
- expect ~context:None "<svg><![CDATA[foo]]]]><![CDATA[></svg>"
- [
- (1, 1, S (`Start_element ((svg_ns, "svg"), [])));
- (1, 15, S (`Text [ "foo" ]));
- (1, 21, S `End_element);
- ] );
- ( "html.parser.large-text" >:: fun _ ->
- with_text_limit 8 (fun () ->
- expect ~context:None "foobar" [ (1, 1, S (`Text [ "foobar" ])) ];
- expect ~context:None "foobarbaz"
- [ (1, 1, S (`Text [ "foobarba"; "z" ])) ]) );
- ( "html.parser.adoption-agency.simple" >:: fun _ ->
- expect ~context:None "foo<b>bar</b>baz"
- [
- (1, 1, S (`Text [ "foo" ]));
- (1, 4, S (start_element "b"));
- (1, 7, S (`Text [ "bar" ]));
- (1, 10, S `End_element);
- (1, 14, S (`Text [ "baz" ]));
- ] );
- ( "html.parser.adoption-agency.stray" >:: fun _ ->
- expect ~context:None "foo</b>bar"
- [
- (1, 4, E (`Unmatched_end_tag "b")); (1, 1, S (`Text [ "foo"; "bar" ]));
- ] );
- ( "html.parser.adoption-agency.nested" >:: fun _ ->
- expect ~context:None "foo<b>bar<em>baz</em>quux</b>lulz"
- [
- (1, 1, S (`Text [ "foo" ]));
- (1, 4, S (start_element "b"));
- (1, 7, S (`Text [ "bar" ]));
- (1, 10, S (start_element "em"));
- (1, 14, S (`Text [ "baz" ]));
- (1, 17, S `End_element);
- (1, 22, S (`Text [ "quux" ]));
- (1, 26, S `End_element);
- (1, 30, S (`Text [ "lulz" ]));
- ] );
- ( "html.parser.adoption-agency.nested.stray" >:: fun _ ->
- expect ~context:None "foo<b>bar</em>baz</b>quux"
- [
- (1, 10, E (`Unmatched_end_tag "em"));
- (1, 1, S (`Text [ "foo" ]));
- (1, 4, S (start_element "b"));
- (1, 7, S (`Text [ "bar"; "baz" ]));
- (1, 18, S `End_element);
- (1, 22, S (`Text [ "quux" ]));
- ] );
- ( "html.parser.adoption-agency.interleaved" >:: fun _ ->
- expect ~context:None "foo<b>bar<em>baz</b>quux</em>"
- [
- (1, 17, E (`Unmatched_end_tag "b"));
- (1, 1, S (`Text [ "foo" ]));
- (1, 4, S (start_element "b"));
- (1, 7, S (`Text [ "bar" ]));
- (1, 10, S (start_element "em"));
- (1, 14, S (`Text [ "baz" ]));
- (1, 17, S `End_element);
- (1, 17, S `End_element);
- (1, 10, S (start_element "em"));
- (1, 21, S (`Text [ "quux" ]));
- (1, 25, S `End_element);
- ] );
- ( "html.parser.adoption-agency.block" >:: fun _ ->
- expect ~context:None "foo<b>bar<p>baz</b>quux"
- [
- (1, 16, E (`Unmatched_end_tag "b"));
- (1, 1, S (`Text [ "foo" ]));
- (1, 4, S (start_element "b"));
- (1, 7, S (`Text [ "bar" ]));
- (1, 16, S `End_element);
- (1, 10, S (start_element "p"));
- (1, 4, S (start_element "b"));
- (1, 13, S (`Text [ "baz" ]));
- (1, 16, S `End_element);
- (1, 20, S (`Text [ "quux" ]));
- (1, 24, S `End_element);
- ] );
- ( "html.parser.adoption-agency.block.nested" >:: fun _ ->
- expect ~context:None "foo<b>bar<em>baz<strong>quux<p>blah</b>lulz"
- [
- (1, 36, E (`Unmatched_end_tag "b"));
- (1, 17, E (`Unmatched_start_tag "strong"));
- (1, 10, E (`Unmatched_start_tag "em"));
- (1, 1, S (`Text [ "foo" ]));
- (1, 4, S (start_element "b"));
- (1, 7, S (`Text [ "bar" ]));
- (1, 10, S (start_element "em"));
- (1, 14, S (`Text [ "baz" ]));
- (1, 17, S (start_element "strong"));
- (1, 25, S (`Text [ "quux" ]));
- (1, 36, S `End_element);
- (1, 36, S `End_element);
- (1, 36, S `End_element);
- (1, 10, S (start_element "em"));
- (1, 17, S (start_element "strong"));
- (1, 29, S (start_element "p"));
- (1, 4, S (start_element "b"));
- (1, 32, S (`Text [ "blah" ]));
- (1, 36, S `End_element);
- (1, 40, S (`Text [ "lulz" ]));
- (1, 44, S `End_element);
- (1, 44, S `End_element);
- (1, 44, S `End_element);
- ] );
- ( "html.parser.adoption-agency.reconstructed" >:: fun _ ->
- expect ~context:None "<p><b>foo<p>bar<em>baz</b>quux"
- [
- (1, 1, S (start_element "p"));
- (1, 4, E (`Unmatched_start_tag "b"));
- (1, 4, S (start_element "b"));
- (1, 7, S (`Text [ "foo" ]));
- (1, 10, S `End_element);
- (1, 10, S `End_element);
- (1, 10, S (start_element "p"));
- (1, 23, E (`Unmatched_end_tag "b"));
- (1, 16, E (`Unmatched_start_tag "em"));
- (1, 4, S (start_element "b"));
- (1, 13, S (`Text [ "bar" ]));
- (1, 16, S (start_element "em"));
- (1, 20, S (`Text [ "baz" ]));
- (1, 23, S `End_element);
- (1, 23, S `End_element);
- (1, 16, S (start_element "em"));
- (1, 27, S (`Text [ "quux" ]));
- (1, 31, S `End_element);
- (1, 31, S `End_element);
- ] );
- ( "html.parser.noscript" >:: fun _ ->
- expect ~context:None "<head><noscript><meta></noscript></head>"
- [
- (1, 1, S (start_element "head"));
- (1, 7, S (start_element "noscript"));
- (1, 17, S (start_element "meta"));
- (1, 17, S `End_element);
- (1, 23, S `End_element);
- (1, 34, S `End_element);
- ] );
- ( "html.parser.noscript.bad" >:: fun _ ->
- expect ~context:None
- "<head><noscript><!DOCTYPE \
- html><html><head><noscript></head></noscript>"
- [
- (1, 1, S (start_element "head"));
- (1, 7, S (start_element "noscript"));
- (1, 17, E (`Bad_document "doctype should be first"));
- (1, 32, E (`Misnested_tag ("html", "noscript", [])));
- (1, 38, E (`Misnested_tag ("head", "noscript", [])));
- (1, 44, E (`Misnested_tag ("noscript", "noscript", [])));
- (1, 54, E (`Unmatched_end_tag "head"));
- (1, 61, S `End_element);
- (1, 72, S `End_element);
- ] );
- ( "html.parser.noscript.head.content" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "head"))
- "<noscript> \t\n<!--foo--> foo</noscript>"
- [
- (1, 1, S (start_element "noscript"));
- (1, 11, S (`Text [ " \t\n" ]));
- (2, 1, S (`Comment "foo"));
- (2, 12, E (`Bad_content "noscript"));
- (2, 11, S (`Text [ " " ]));
- (2, 12, S `End_element);
- (2, 12, S (start_element "body"));
- (2, 15, E (`Unmatched_end_tag "noscript"));
- (2, 12, S (`Text [ "foo" ]));
- (2, 26, S `End_element);
- ] );
- ( "html.parser.noscript.inferred.content" >:: fun _ ->
- expect ~context:None "<noscript> \t\n<!--foo--> foo</noscript>"
- [
- (1, 1, S (start_element "noscript"));
- (1, 11, S (`Text [ " \t\n" ]));
- (2, 1, S (`Comment "foo"));
- (2, 11, S (`Text [ " foo" ]));
- (2, 15, S `End_element);
- ] );
- ( "html.parser.noscript-script.inferred.content" >:: fun _ ->
- expect ~context:None "<script>foo</script><noscript>bar</noscript>"
- [
- (1, 1, S (start_element "script"));
- (1, 9, S (`Text [ "foo" ]));
- (1, 12, S `End_element);
- (1, 21, S (start_element "noscript"));
- (1, 31, S (`Text [ "bar" ]));
- (1, 34, S `End_element);
- ] );
- ( "html.parser.head.fragment" >:: fun _ ->
- expect ~context:None "<base>"
- [ (1, 1, S (start_element "base")); (1, 1, S `End_element) ];
-
- expect ~context:None "<basefont>"
- [ (1, 1, S (start_element "basefont")); (1, 1, S `End_element) ];
-
- expect ~context:None "<bgsound>"
- [ (1, 1, S (start_element "bgsound")); (1, 1, S `End_element) ];
-
- expect ~context:None "<link>"
- [ (1, 1, S (start_element "link")); (1, 1, S `End_element) ];
-
- expect ~context:None "<meta>"
- [ (1, 1, S (start_element "meta")); (1, 1, S `End_element) ];
-
- expect ~context:None "<noframes></noframes>"
- [ (1, 1, S (start_element "noframes")); (1, 11, S `End_element) ];
-
- expect ~context:None "<style></style>"
- [ (1, 1, S (start_element "style")); (1, 8, S `End_element) ] );
- ( "html.parser.body.fragment" >:: fun _ ->
- expect ~context:None "<body></body>"
- [ (1, 1, S (start_element "body")); (1, 14, S `End_element) ] );
- ( "html.parser.body.content-truncated" >:: fun _ ->
- expect ~context:None "<p></body></html>foo"
- [
- (1, 1, S (start_element "p"));
- (1, 4, E (`Unmatched_end_tag "body"));
- (1, 11, E (`Unmatched_end_tag "html"));
- (1, 18, S (`Text [ "foo" ]));
- (1, 21, S `End_element);
- ] );
- ( "html.parser.nested-button" >:: fun _ ->
- expect ~context:None "<button><button>submit</button></button>"
- [
- (1, 1, S (start_element "button"));
- (1, 9, E (`Misnested_tag ("button", "button", [])));
- (1, 9, S `End_element);
- (1, 9, S (start_element "button"));
- (1, 17, S (`Text [ "submit" ]));
- (1, 23, S `End_element);
- (1, 32, E (`Unmatched_end_tag "button"));
- ] );
- ( "html.parser.nested-list" >:: fun _ ->
- expect ~context:None "<ul><li><ul></li></ul></li></ul>"
- [
- (1, 1, S (start_element "ul"));
- (1, 5, S (start_element "li"));
- (1, 9, S (start_element "ul"));
- (1, 13, E (`Unmatched_end_tag "li"));
- (1, 18, S `End_element);
- (1, 23, S `End_element);
- (1, 28, S `End_element);
- ] );
- ( "html.parser.definitions" >:: fun _ ->
- expect ~context:None "</dd><dd></dd>"
- [
- (1, 1, E (`Unmatched_end_tag "dd"));
- (1, 6, S (start_element "dd"));
- (1, 10, S `End_element);
- ] );
- ( "html.parser.nested-achor" >:: fun _ ->
- expect ~context:None "<a><a></a></a>"
- [
- (1, 4, E (`Misnested_tag ("a", "a", [])));
- (1, 11, E (`Unmatched_end_tag "a"));
- (1, 1, S (start_element "a"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "a"));
- (1, 7, S `End_element);
- ] );
- ( "html.parser.nested-anchor.reconstruct" >:: fun _ ->
- expect ~context:None "<p><a>foo<a>bar<p>baz"
- [
- (1, 1, S (start_element "p"));
- (1, 10, E (`Misnested_tag ("a", "a", [])));
- (1, 10, E (`Unmatched_start_tag "a"));
- (1, 4, S (start_element "a"));
- (1, 7, S (`Text [ "foo" ]));
- (1, 10, S `End_element);
- (1, 10, S (start_element "a"));
- (1, 13, S (`Text [ "bar" ]));
- (1, 16, S `End_element);
- (1, 16, S `End_element);
- (1, 16, S (start_element "p"));
- (1, 10, E (`Unmatched_start_tag "a"));
- (1, 10, S (start_element "a"));
- (1, 19, S (`Text [ "baz" ]));
- (1, 22, S `End_element);
- (1, 22, S `End_element);
- ] );
- ( "html.parser.nested-nobr" >:: fun _ ->
- expect ~context:None "foo<nobr>bar<nobr>baz</nobr>quux</nobr>blah"
- [
- (1, 13, E (`Misnested_tag ("nobr", "nobr", [])));
- (1, 33, E (`Unmatched_end_tag "nobr"));
- (1, 1, S (`Text [ "foo" ]));
- (1, 4, S (start_element "nobr"));
- (1, 10, S (`Text [ "bar" ]));
- (1, 13, S `End_element);
- (1, 13, S (start_element "nobr"));
- (1, 19, S (`Text [ "baz" ]));
- (1, 22, S `End_element);
- (1, 29, S (`Text [ "quux"; "blah" ]));
- ] );
- ( "html.parser.end-br" >:: fun _ ->
- expect ~context:None "<br></br>"
- [
- (1, 1, S (start_element "br"));
- (1, 1, S `End_element);
- (1, 5, E (`Unmatched_end_tag "br"));
- (1, 5, S (start_element "br"));
- (1, 5, S `End_element);
- ] );
- ( "html.parser.hr" >:: fun _ ->
- expect ~context:None "<p><hr>"
- [
- (1, 1, S (start_element "p"));
- (1, 4, S `End_element);
- (1, 4, S (start_element "hr"));
- (1, 4, S `End_element);
- ] );
- ( "html.parser.input" >:: fun _ ->
- expect ~context:None "<input type='text'>"
- [
- ( 1,
- 1,
- S (`Start_element ((html_ns, "input"), [ (("", "type"), "text") ]))
- );
- (1, 1, S `End_element);
- ] );
- ( "html.parser.iframe" >:: fun _ ->
- expect ~context:None "<iframe><p>foo&</p></iframe>"
- [
- (1, 1, S (start_element "iframe"));
- (1, 9, S (`Text [ "<p>foo&</p>" ]));
- (1, 24, S `End_element);
- ] );
- ( "html.parser.noembed" >:: fun _ ->
- expect ~context:None "<noembed><p>foo&</p></noembed>"
- [
- (1, 1, S (start_element "noembed"));
- (1, 10, S (`Text [ "<p>foo&</p>" ]));
- (1, 25, S `End_element);
- ] );
- ( "html.parser.generic-tag" >:: fun _ ->
- expect ~context:None "<foo></foo>"
- [ (1, 1, S (start_element "foo")); (1, 6, S `End_element) ] );
- ( "html.parser.option.body" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<option><optgroup></optgroup>"
- [
- (1, 1, S (start_element "option"));
- (1, 9, S `End_element);
- (1, 9, S (start_element "optgroup"));
- (1, 19, S `End_element);
- ] );
- ( "html.parser.table-content-in-body" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<caption><col><colgroup><tbody><td><tfoot><th><thead><tr>"
- [
- (1, 1, E (`Misnested_tag ("caption", "body", [])));
- (1, 10, E (`Misnested_tag ("col", "body", [])));
- (1, 15, E (`Misnested_tag ("colgroup", "body", [])));
- (1, 25, E (`Misnested_tag ("tbody", "body", [])));
- (1, 32, E (`Misnested_tag ("td", "body", [])));
- (1, 36, E (`Misnested_tag ("tfoot", "body", [])));
- (1, 43, E (`Misnested_tag ("th", "body", [])));
- (1, 47, E (`Misnested_tag ("thead", "body", [])));
- (1, 54, E (`Misnested_tag ("tr", "body", [])));
- ] );
- ( "html.parser.caption" >:: fun _ ->
- expect ~context:None "<table><caption>foo<p>bar</caption></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S (start_element "caption"));
- (1, 17, S (`Text [ "foo" ]));
- (1, 20, S (start_element "p"));
- (1, 23, S (`Text [ "bar" ]));
- (1, 26, S `End_element);
- (1, 26, S `End_element);
- (1, 36, S `End_element);
- ] );
- ( "html.parser.colgroup" >:: fun _ ->
- expect ~context:None "<table><colgroup><col></colgroup></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S (start_element "colgroup"));
- (1, 18, S (start_element "col"));
- (1, 18, S `End_element);
- (1, 23, S `End_element);
- (1, 34, S `End_element);
- ] );
- ( "html.parser.colgroup.implicit" >:: fun _ ->
- expect ~context:None "<table><col></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S (start_element "colgroup"));
- (1, 8, S (start_element "col"));
- (1, 8, S `End_element);
- (1, 13, S `End_element);
- (1, 13, S `End_element);
- ] );
- ( "html.parser.td.direct" >:: fun _ ->
- expect ~context:None "<table><td></td></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S (start_element "tbody"));
- (1, 8, E (`Misnested_tag ("td", "table", [])));
- (1, 8, S (start_element "tr"));
- (1, 8, S (start_element "td"));
- (1, 12, S `End_element);
- (1, 17, S `End_element);
- (1, 17, S `End_element);
- (1, 17, S `End_element);
- ] );
- ( "html.parser.tbody" >:: fun _ ->
- expect ~context:None "<table><tbody></tbody></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S (start_element "tbody"));
- (1, 15, S `End_element);
- (1, 23, S `End_element);
- ] );
- ( "html.parser.nested-table" >:: fun _ ->
- expect ~context:None "<table><table></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, E (`Misnested_tag ("table", "table", [])));
- (1, 8, S `End_element);
- (1, 8, S (start_element "table"));
- (1, 15, S `End_element);
- ] );
- ( "html.parser.nested-caption" >:: fun _ ->
- expect ~context:None "<table><caption><caption></caption></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S (start_element "caption"));
- (1, 17, E (`Misnested_tag ("caption", "caption", [])));
- (1, 17, S `End_element);
- (1, 17, S (start_element "caption"));
- (1, 26, S `End_element);
- (1, 36, S `End_element);
- ] );
- ( "html.parser.truncated-caption" >:: fun _ ->
- expect ~context:None "<table><caption></table>"
- [
- (1, 1, S (start_element "table"));
- (1, 8, S (start_element "caption"));
- (1, 17, E (`Unmatched_end_tag "table"));
- (1, 17, S `End_element);
- (1, 17, S `End_element);
- ] );
- ( "html.parser.nested-tbody" >:: fun _ ->
- expect ~context:None "<tbody><tbody></tbody>"
- [
- (1, 1, S (start_element "tbody"));
- (1, 8, S `End_element);
- (1, 8, S (start_element "tbody"));
- (1, 15, S `End_element);
- ] );
- ( "html.parser.option" >:: fun _ ->
- expect ~context:None "<option></option>"
- [ (1, 1, S (start_element "option")); (1, 9, S `End_element) ] );
- ( "html.parser.optgroup" >:: fun _ ->
- expect ~context:None
- "<select><optgroup><option><optgroup><option></optgroup></select>"
- [
- (1, 1, S (start_element "select"));
- (1, 9, S (start_element "optgroup"));
- (1, 19, S (start_element "option"));
- (1, 27, S `End_element);
- (1, 27, S `End_element);
- (1, 27, S (start_element "optgroup"));
- (1, 37, S (start_element "option"));
- (1, 45, S `End_element);
- (1, 45, S `End_element);
- (1, 56, S `End_element);
- ] );
- ( "html.parser.form" >:: fun _ ->
- expect ~context:None "<form></form>"
- [ (1, 1, S (start_element "form")); (1, 7, S `End_element) ] );
- ( "html.parser.form.nested" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<form><form></form>"
- [
- (1, 1, S (start_element "form"));
- (1, 7, E (`Misnested_tag ("form", "form", [])));
- (1, 13, S `End_element);
- ] );
- ( "html.parser.form.unopened" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "</form>"
- [ (1, 1, E (`Unmatched_end_tag "form")) ] );
- ( "html.parser.noframes" >:: fun _ ->
- expect ~context:None "<noframes>foo&bar</a></noframes>"
- [
- (1, 1, S (start_element "noframes"));
- (1, 11, S (`Text [ "foo&bar</a>" ]));
- (1, 26, S `End_element);
- ] );
- ( "html.parser.frameset" >:: fun _ ->
- expect "<frameset><frame></frameset>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "frameset"));
- (1, 11, S (start_element "frame"));
- (1, 11, S `End_element);
- (1, 18, S `End_element);
- (1, 29, S `End_element);
- ] );
- ( "html.parser.frameset.fragment" >:: fun _ ->
- expect ~context:None "<frameset></frameset>"
- [ (1, 1, S (start_element "frameset")); (1, 11, S `End_element) ];
-
- expect ~context:None "<frame>"
- [ (1, 1, S (start_element "frame")); (1, 1, S `End_element) ] );
- ( "html.parser.frameset.content" >:: fun _ ->
- expect ~context:None
- ("<frameset> \t\n<!--foo--><noframes></noframes><frameset></frameset>"
- ^ "</frameset>")
- [
- (1, 1, S (start_element "frameset"));
- (1, 11, S (`Text [ " \t\n" ]));
- (2, 1, S (`Comment "foo"));
- (2, 11, S (start_element "noframes"));
- (2, 21, S `End_element);
- (2, 32, S (start_element "frameset"));
- (2, 42, S `End_element);
- (2, 53, S `End_element);
- ] );
- ( "html.parser.frameset.bad" >:: fun _ ->
- expect ~context:None "<frameset><!DOCTYPE html><html>f"
- [
- (1, 1, S (start_element "frameset"));
- (1, 11, E (`Bad_document "doctype should be first"));
- (1, 26, E (`Misnested_tag ("html", "frameset", [])));
- (1, 32, E (`Bad_content "frameset"));
- (1, 33, E (`Unexpected_eoi "frameset"));
- (1, 33, S `End_element);
- ] );
- ( "html.parser.after-frameset.content" >:: fun _ ->
- expect ~context:None
- "<frameset></frameset> \t\n<!--foo--><noframes></noframes></html>"
- [
- (1, 1, S (start_element "frameset"));
- (1, 11, S `End_element);
- (1, 22, S (`Text [ " \t\n" ]));
- (2, 1, S (`Comment "foo"));
- (2, 11, S (start_element "noframes"));
- (2, 21, S `End_element);
- ] );
- ( "html.parser.after-frameset.bad" >:: fun _ ->
- expect ~context:None "<frameset></frameset><!DOCTYPE html><html>f"
- [
- (1, 1, S (start_element "frameset"));
- (1, 11, S `End_element);
- (1, 22, E (`Bad_document "doctype should be first"));
- (1, 37, E (`Misnested_tag ("html", "html", [])));
- (1, 43, E (`Bad_content "html"));
- ] );
- ( "html.parser.frameset-in-body" >:: fun _ ->
- expect
- ~context:(Some (`Fragment "body"))
- "<frameset><p>"
- [
- (1, 1, E (`Misnested_tag ("frameset", "body", [])));
- (1, 11, S (start_element "p"));
- (1, 14, S `End_element);
- ];
-
- expect ~context:None "<body><p><frameset><p></body>"
- [
- (1, 1, S (start_element "body"));
- (1, 7, S (start_element "p"));
- (1, 10, E (`Misnested_tag ("frameset", "body", [])));
- (1, 20, S `End_element);
- (1, 20, S (start_element "p"));
- (1, 30, S `End_element);
- (1, 30, S `End_element);
- ];
-
- expect ~context:None "<p><frameset><p>"
- [
- (1, 1, S (start_element "p"));
- (1, 4, E (`Misnested_tag ("frameset", "body", [])));
- (1, 14, S `End_element);
- (1, 14, S (start_element "p"));
- (1, 17, S `End_element);
- ];
-
- expect "<p><frameset><frame></frameset>"
- [
- (1, 1, S (start_element "html"));
- (1, 1, S (start_element "head"));
- (1, 1, S `End_element);
- (1, 1, S (start_element "body"));
- (1, 1, S (start_element "p"));
- (1, 4, E (`Misnested_tag ("frameset", "body", [])));
- (1, 4, S `End_element);
- (1, 4, S `End_element);
- (1, 4, S (start_element "frameset"));
- (1, 14, S (start_element "frame"));
- (1, 14, S `End_element);
- (1, 21, S `End_element);
- (1, 32, S `End_element);
- ] );
- ]
diff --git a/test/test_ragel_tokenizer.ml b/test/test_ragel_tokenizer.ml
new file mode 100644
index 0000000..e50d999
--- /dev/null
+++ b/test/test_ragel_tokenizer.ml
@@ -0,0 +1,35 @@
+open OUnit2
+
+let tag name attributes : Markup__Common.Token_tag.t =
+ {name; attributes; self_closing = false}
+
+let tokens_without_locations html =
+ html |> Ragel_html_tokenizer.tokenize |> List.map snd
+
+let tests =
+ [
+ ( "private.html-tokenize.tokens" >:: fun _ ->
+ let actual =
+ tokens_without_locations
+ "<br/><p a='&'><</p><script>&</script><style>x</style>"
+ in
+ let expected : Markup__Html_tokenizer.token list =
+ [
+ `Start (tag "br" []);
+ `Start (tag "p" ["a", "&"]);
+ `String "<";
+ `End (tag "p" []);
+ `Start (tag "script" []);
+ `String "&";
+ `End (tag "script" []);
+ `Start (tag "style" []);
+ `String "x";
+ `End (tag "style" []);
+ `EOF;
+ ]
+ in
+ assert_equal expected actual );
+ ( "private.html-tokenize.locations" >:: fun _ ->
+ let actual = Ragel_html_tokenizer.tokenize "one\ntwo" in
+ assert_equal [((2, -1), `String "one\ntwo"); ((2, -1), `EOF)] actual );
+ ]
]]></plaintext></p></div></x@y></p></td></tr></div> |