OCaml HTML5 parser/serialiser based on Python's JustHTML

html

+27 -1
lib/html5rw/parser/parser_constants.ml
··· 3 (* Use Astring for string operations *) 4 let lowercase = Astring.String.Ascii.lowercase 5 6 (* Void elements - no end tag allowed *) 7 let void_elements = [ 8 "area"; "base"; "br"; "col"; "embed"; "hr"; "img"; "input"; 9 "link"; "meta"; "source"; "track"; "wbr" 10 ] 11 12 (* Raw text elements - content is raw text *) 13 let raw_text_elements = ["script"; "style"] ··· 20 "a"; "b"; "big"; "code"; "em"; "font"; "i"; "nobr"; "s"; "small"; 21 "strike"; "strong"; "tt"; "u" 22 ] 23 24 (* Special elements *) 25 let special_elements = [ ··· 35 "tbody"; "td"; "template"; "textarea"; "tfoot"; "th"; "thead"; "title"; 36 "tr"; "track"; "ul"; "wbr"; "xmp" 37 ] 38 39 (* Heading elements *) 40 let heading_elements = ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] 41 42 (* Implied end tag elements *) 43 let implied_end_tags = [ 44 "dd"; "dt"; "li"; "optgroup"; "option"; "p"; "rb"; "rp"; "rt"; "rtc" 45 ] 46 47 (* Thoroughly implied end tags *) 48 let thoroughly_implied_end_tags = [ 49 "caption"; "colgroup"; "dd"; "dt"; "li"; "optgroup"; "option"; "p"; 50 "rb"; "rp"; "rt"; "rtc"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr" 51 ] 52 53 (* Scope elements for various scope checks *) 54 let default_scope = [ ··· 62 let table_scope = ["html"; "table"; "template"] 63 64 let select_scope_exclude = ["optgroup"; "option"] 65 66 (* MathML text integration points *) 67 let mathml_text_integration = ["mi"; "mo"; "mn"; "ms"; "mtext"] 68 69 (* MathML attribute adjustments *) 70 let mathml_attr_adjustments = [ ··· 80 81 (* SVG HTML integration points *) 82 let svg_html_integration = ["foreignObject"; "desc"; "title"] 83 84 (* SVG tag name adjustments *) 85 let svg_tag_adjustments = [ ··· 278 "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd" 279 ] 280 281 - (* Helper functions *) 282 let is_void = List.mem 283 let is_formatting = List.mem 284 let is_special name = List.mem name special_elements
··· 3 (* Use Astring for string operations *) 4 let lowercase = Astring.String.Ascii.lowercase 5 6 + (* Helper to create a hashtable set from a list for O(1) membership *) 7 + let make_set elements = 8 + let tbl = Hashtbl.create (List.length elements) in 9 + List.iter (fun e -> Hashtbl.add tbl e ()) elements; 10 + tbl 11 + 12 (* Void elements - no end tag allowed *) 13 let void_elements = [ 14 "area"; "base"; "br"; "col"; "embed"; "hr"; "img"; "input"; 15 "link"; "meta"; "source"; "track"; "wbr" 16 ] 17 + let void_elements_tbl = make_set void_elements 18 19 (* Raw text elements - content is raw text *) 20 let raw_text_elements = ["script"; "style"] ··· 27 "a"; "b"; "big"; "code"; "em"; "font"; "i"; "nobr"; "s"; "small"; 28 "strike"; "strong"; "tt"; "u" 29 ] 30 + let formatting_elements_tbl = make_set formatting_elements 31 32 (* Special elements *) 33 let special_elements = [ ··· 43 "tbody"; "td"; "template"; "textarea"; "tfoot"; "th"; "thead"; "title"; 44 "tr"; "track"; "ul"; "wbr"; "xmp" 45 ] 46 + let special_elements_tbl = make_set special_elements 47 48 (* Heading elements *) 49 let heading_elements = ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] 50 + let heading_elements_tbl = make_set heading_elements 51 52 (* Implied end tag elements *) 53 let implied_end_tags = [ 54 "dd"; "dt"; "li"; "optgroup"; "option"; "p"; "rb"; "rp"; "rt"; "rtc" 55 ] 56 + let implied_end_tags_tbl = make_set implied_end_tags 57 58 (* Thoroughly implied end tags *) 59 let thoroughly_implied_end_tags = [ 60 "caption"; "colgroup"; "dd"; "dt"; "li"; "optgroup"; "option"; "p"; 61 "rb"; "rp"; "rt"; "rtc"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr" 62 ] 63 + let thoroughly_implied_end_tags_tbl = make_set thoroughly_implied_end_tags 64 65 (* Scope elements for various scope checks *) 66 let default_scope = [ ··· 74 let table_scope = ["html"; "table"; "template"] 75 76 let select_scope_exclude = ["optgroup"; "option"] 77 + let select_scope_exclude_tbl = make_set select_scope_exclude 78 79 (* MathML text integration points *) 80 let mathml_text_integration = ["mi"; "mo"; "mn"; "ms"; "mtext"] 81 + let mathml_text_integration_tbl = make_set mathml_text_integration 82 83 (* MathML attribute adjustments *) 84 let mathml_attr_adjustments = [ ··· 94 95 (* SVG HTML integration points *) 96 let svg_html_integration = ["foreignObject"; "desc"; "title"] 97 + let svg_html_integration_tbl = make_set (List.map lowercase svg_html_integration) 98 99 (* SVG tag name adjustments *) 100 let svg_tag_adjustments = [ ··· 293 "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd" 294 ] 295 296 + (* Helper functions - O(1) hashtable lookups *) 297 + let is_void_element name = Hashtbl.mem void_elements_tbl name 298 + let is_formatting_element name = Hashtbl.mem formatting_elements_tbl name 299 + let is_special_element name = Hashtbl.mem special_elements_tbl name 300 + let is_heading_element name = Hashtbl.mem heading_elements_tbl name 301 + let is_implied_end_tag name = Hashtbl.mem implied_end_tags_tbl name 302 + let is_thoroughly_implied_end_tag name = Hashtbl.mem thoroughly_implied_end_tags_tbl name 303 + let is_mathml_text_integration name = Hashtbl.mem mathml_text_integration_tbl name 304 + let is_svg_html_integration name = Hashtbl.mem svg_html_integration_tbl (lowercase name) 305 + let is_select_scope_exclude name = Hashtbl.mem select_scope_exclude_tbl name 306 + 307 + (* Backwards compatibility aliases *) 308 let is_void = List.mem 309 let is_formatting = List.mem 310 let is_special name = List.mem name special_elements
+14 -14
lib/html5rw/parser/parser_tree_builder.ml
··· 294 let is_html_integration_point node = 295 (* SVG foreignObject, desc, and title are always HTML integration points *) 296 if node.Dom.namespace = Some "svg" && 297 - List.mem node.Dom.name Parser_constants.svg_html_integration then true 298 (* annotation-xml is an HTML integration point only with specific encoding values *) 299 else if node.Dom.namespace = Some "mathml" && node.Dom.name = "annotation-xml" then 300 match List.assoc_opt "encoding" node.Dom.attrs with ··· 307 (* Check if element is a MathML text integration point *) 308 let is_mathml_text_integration_point node = 309 node.Dom.namespace = Some "mathml" && 310 - List.mem node.Dom.name ["mi"; "mo"; "mn"; "ms"; "mtext"] 311 312 (* Scope checks - integration points also terminate scope (except for table scope) *) 313 (* Per WHATWG spec, scope checks only consider HTML namespace elements for the target names *) ··· 341 | [] -> false 342 | n :: rest -> 343 if n.Dom.name = name then true 344 - else if not (List.mem n.Dom.name Parser_constants.select_scope_exclude) then false 345 else check rest 346 in 347 check t.open_elements ··· 350 let generate_implied_end_tags t ?except () = 351 let rec loop () = 352 match current_node t with 353 - | Some n when List.mem n.Dom.name Parser_constants.implied_end_tags -> 354 (match except with 355 | Some ex when n.Dom.name = ex -> () 356 | _ -> pop_current t; loop ()) ··· 361 let generate_all_implied_end_tags t = 362 let rec loop () = 363 match current_node t with 364 - | Some n when List.mem n.Dom.name Parser_constants.thoroughly_implied_end_tags -> 365 pop_current t; loop () 366 | _ -> () 367 in ··· 1105 when List.mem name ["address"; "article"; "aside"; "blockquote"; "center"; "details"; "dialog"; "dir"; "div"; "dl"; "fieldset"; "figcaption"; "figure"; "footer"; "header"; "hgroup"; "main"; "menu"; "nav"; "ol"; "p"; "search"; "section"; "summary"; "ul"] -> 1106 if has_element_in_button_scope t "p" then close_p_element t; 1107 ignore (insert_element t name ~push:true attrs) 1108 - | Token.Tag { kind = Token.Start; name; attrs; _ } when List.mem name Parser_constants.heading_elements -> 1109 if has_element_in_button_scope t "p" then close_p_element t; 1110 (match current_node t with 1111 - | Some n when List.mem n.Dom.name Parser_constants.heading_elements -> 1112 parse_error t "unexpected-start-tag"; 1113 pop_current t 1114 | _ -> ()); ··· 1243 | _ -> ()); 1244 pop_until_tag t name 1245 end 1246 - | Token.Tag { kind = Token.End; name; _ } when List.mem name Parser_constants.heading_elements -> 1247 if not (has_element_in_scope_impl t Parser_constants.heading_elements Parser_constants.default_scope ~check_integration_points:true) then 1248 parse_error t "unexpected-end-tag" 1249 else begin ··· 1437 reconstruct_active_formatting t; 1438 ignore (insert_element t name ~push:true attrs); 1439 (* Check for self-closing on non-void HTML element *) 1440 - if self_closing && not (List.mem name Parser_constants.void_elements) then 1441 parse_error t "non-void-html-element-start-tag-with-trailing-solidus" 1442 | Token.Tag { kind = Token.End; name; _ } -> 1443 (* Any other end tag *) ··· 1943 ignore (insert_element t name attrs) 1944 (* Don't push to stack - void elements *) 1945 (* Handle formatting elements in select *) 1946 - | Token.Tag { kind = Token.Start; name; attrs; _ } when List.mem name Parser_constants.formatting_elements -> 1947 reconstruct_active_formatting t; 1948 let node = insert_element t name ~push:true attrs in 1949 push_formatting_element t node name attrs 1950 - | Token.Tag { kind = Token.End; name; _ } when List.mem name Parser_constants.formatting_elements -> 1951 (* Find select element and check if formatting element is inside select *) 1952 let select_idx = ref None in 1953 let fmt_idx = ref None in ··· 2211 let is_html_integration_point node = 2212 (* SVG foreignObject, desc, and title are always HTML integration points *) 2213 if node.Dom.namespace = Some "svg" && 2214 - List.mem node.Dom.name Parser_constants.svg_html_integration then true 2215 (* annotation-xml is an HTML integration point only with specific encoding values *) 2216 else if node.Dom.namespace = Some "mathml" && node.Dom.name = "annotation-xml" then 2217 match List.assoc_opt "encoding" node.Dom.attrs with ··· 2224 (* Check for MathML text integration points *) 2225 let is_mathml_text_integration_point node = 2226 node.Dom.namespace = Some "mathml" && 2227 - List.mem node.Dom.name ["mi"; "mo"; "mn"; "ms"; "mtext"] 2228 in 2229 (* Foreign content handling *) 2230 let in_foreign = ··· 2293 let is_html_integration_point node = 2294 (* SVG foreignObject, desc, and title are always HTML integration points *) 2295 if node.Dom.namespace = Some "svg" && 2296 - List.mem node.Dom.name Parser_constants.svg_html_integration then true 2297 (* annotation-xml is an HTML integration point only with specific encoding values *) 2298 else if node.Dom.namespace = Some "mathml" && node.Dom.name = "annotation-xml" then 2299 match List.assoc_opt "encoding" node.Dom.attrs with
··· 294 let is_html_integration_point node = 295 (* SVG foreignObject, desc, and title are always HTML integration points *) 296 if node.Dom.namespace = Some "svg" && 297 + Parser_constants.is_svg_html_integration node.Dom.name then true 298 (* annotation-xml is an HTML integration point only with specific encoding values *) 299 else if node.Dom.namespace = Some "mathml" && node.Dom.name = "annotation-xml" then 300 match List.assoc_opt "encoding" node.Dom.attrs with ··· 307 (* Check if element is a MathML text integration point *) 308 let is_mathml_text_integration_point node = 309 node.Dom.namespace = Some "mathml" && 310 + Parser_constants.is_mathml_text_integration node.Dom.name 311 312 (* Scope checks - integration points also terminate scope (except for table scope) *) 313 (* Per WHATWG spec, scope checks only consider HTML namespace elements for the target names *) ··· 341 | [] -> false 342 | n :: rest -> 343 if n.Dom.name = name then true 344 + else if not (Parser_constants.is_select_scope_exclude n.Dom.name) then false 345 else check rest 346 in 347 check t.open_elements ··· 350 let generate_implied_end_tags t ?except () = 351 let rec loop () = 352 match current_node t with 353 + | Some n when Parser_constants.is_implied_end_tag n.Dom.name -> 354 (match except with 355 | Some ex when n.Dom.name = ex -> () 356 | _ -> pop_current t; loop ()) ··· 361 let generate_all_implied_end_tags t = 362 let rec loop () = 363 match current_node t with 364 + | Some n when Parser_constants.is_thoroughly_implied_end_tag n.Dom.name -> 365 pop_current t; loop () 366 | _ -> () 367 in ··· 1105 when List.mem name ["address"; "article"; "aside"; "blockquote"; "center"; "details"; "dialog"; "dir"; "div"; "dl"; "fieldset"; "figcaption"; "figure"; "footer"; "header"; "hgroup"; "main"; "menu"; "nav"; "ol"; "p"; "search"; "section"; "summary"; "ul"] -> 1106 if has_element_in_button_scope t "p" then close_p_element t; 1107 ignore (insert_element t name ~push:true attrs) 1108 + | Token.Tag { kind = Token.Start; name; attrs; _ } when Parser_constants.is_heading_element name -> 1109 if has_element_in_button_scope t "p" then close_p_element t; 1110 (match current_node t with 1111 + | Some n when Parser_constants.is_heading_element n.Dom.name -> 1112 parse_error t "unexpected-start-tag"; 1113 pop_current t 1114 | _ -> ()); ··· 1243 | _ -> ()); 1244 pop_until_tag t name 1245 end 1246 + | Token.Tag { kind = Token.End; name; _ } when Parser_constants.is_heading_element name -> 1247 if not (has_element_in_scope_impl t Parser_constants.heading_elements Parser_constants.default_scope ~check_integration_points:true) then 1248 parse_error t "unexpected-end-tag" 1249 else begin ··· 1437 reconstruct_active_formatting t; 1438 ignore (insert_element t name ~push:true attrs); 1439 (* Check for self-closing on non-void HTML element *) 1440 + if self_closing && not (Parser_constants.is_void_element name) then 1441 parse_error t "non-void-html-element-start-tag-with-trailing-solidus" 1442 | Token.Tag { kind = Token.End; name; _ } -> 1443 (* Any other end tag *) ··· 1943 ignore (insert_element t name attrs) 1944 (* Don't push to stack - void elements *) 1945 (* Handle formatting elements in select *) 1946 + | Token.Tag { kind = Token.Start; name; attrs; _ } when Parser_constants.is_formatting_element name -> 1947 reconstruct_active_formatting t; 1948 let node = insert_element t name ~push:true attrs in 1949 push_formatting_element t node name attrs 1950 + | Token.Tag { kind = Token.End; name; _ } when Parser_constants.is_formatting_element name -> 1951 (* Find select element and check if formatting element is inside select *) 1952 let select_idx = ref None in 1953 let fmt_idx = ref None in ··· 2211 let is_html_integration_point node = 2212 (* SVG foreignObject, desc, and title are always HTML integration points *) 2213 if node.Dom.namespace = Some "svg" && 2214 + Parser_constants.is_svg_html_integration node.Dom.name then true 2215 (* annotation-xml is an HTML integration point only with specific encoding values *) 2216 else if node.Dom.namespace = Some "mathml" && node.Dom.name = "annotation-xml" then 2217 match List.assoc_opt "encoding" node.Dom.attrs with ··· 2224 (* Check for MathML text integration points *) 2225 let is_mathml_text_integration_point node = 2226 node.Dom.namespace = Some "mathml" && 2227 + Parser_constants.is_mathml_text_integration node.Dom.name 2228 in 2229 (* Foreign content handling *) 2230 let in_foreign = ··· 2293 let is_html_integration_point node = 2294 (* SVG foreignObject, desc, and title are always HTML integration points *) 2295 if node.Dom.namespace = Some "svg" && 2296 + Parser_constants.is_svg_html_integration node.Dom.name then true 2297 (* annotation-xml is an HTML integration point only with specific encoding values *) 2298 else if node.Dom.namespace = Some "mathml" && node.Dom.name = "annotation-xml" then 2299 match List.assoc_opt "encoding" node.Dom.attrs with
+23
lib/htmlrw_check/datatype/datatype.ml
··· 41 if start > end_pos then "" 42 else String.sub s start (end_pos - start + 1) 43 44 (** Factory for creating enum-based validators. 45 Many HTML attributes accept a fixed set of keyword values. 46 Uses Hashtbl for O(1) membership check. *)
··· 41 if start > end_pos then "" 42 else String.sub s start (end_pos - start + 1) 43 44 + (** Split string on HTML whitespace characters (space, tab, LF, FF, CR). 45 + Filters out empty tokens. Used for space-separated attribute values. *) 46 + let split_on_whitespace s = 47 + let len = String.length s in 48 + let rec split acc start i = 49 + if i >= len then 50 + if i > start then 51 + List.rev ((String.sub s start (i - start)) :: acc) 52 + else 53 + List.rev acc 54 + else if is_whitespace s.[i] then 55 + let acc' = 56 + if i > start then 57 + (String.sub s start (i - start)) :: acc 58 + else 59 + acc 60 + in 61 + split acc' (i + 1) (i + 1) 62 + else 63 + split acc start (i + 1) 64 + in 65 + split [] 0 0 66 + 67 (** Factory for creating enum-based validators. 68 Many HTML attributes accept a fixed set of keyword values. 69 Uses Hashtbl for O(1) membership check. *)
+4
lib/htmlrw_check/datatype/datatype.mli
··· 44 (** Trim HTML5 whitespace from both ends of a string. *) 45 val trim_html_spaces : string -> string 46 47 (** {2 Datatype Factories} *) 48 49 (** Create an enum-based validator for attributes with fixed keyword values.
··· 44 (** Trim HTML5 whitespace from both ends of a string. *) 45 val trim_html_spaces : string -> string 46 47 + (** Split string on HTML5 whitespace characters (space, tab, LF, FF, CR). 48 + Filters out empty tokens. Used for space-separated attribute values. *) 49 + val split_on_whitespace : string -> string list 50 + 51 (** {2 Datatype Factories} *) 52 53 (** Create an enum-based validator for attributes with fixed keyword values.
+6 -20
lib/htmlrw_check/datatype/dt_autocomplete.ml
··· 1 (** Autocomplete attribute validation based on HTML5 spec *) 2 3 - (** Check if character is whitespace *) 4 - let is_whitespace c = c = ' ' || c = '\t' || c = '\n' || c = '\r' 5 6 - (** Convert character to ASCII lowercase *) 7 - let to_ascii_lowercase c = 8 - if c >= 'A' && c <= 'Z' then Char.chr (Char.code c + 32) else c 9 - 10 - (** Trim whitespace from string *) 11 let trim_whitespace s = 12 let s = String.trim s in 13 (* Also collapse internal whitespace *) ··· 104 "impp"; 105 ] 106 107 - (** Split string on whitespace *) 108 - let split_on_whitespace s = 109 - let rec split acc start i = 110 - if i >= String.length s then 111 - if start < i then List.rev (String.sub s start (i - start) :: acc) 112 - else List.rev acc 113 - else if is_whitespace s.[i] then 114 - if start < i then 115 - split (String.sub s start (i - start) :: acc) (i + 1) (i + 1) 116 - else split acc (i + 1) (i + 1) 117 - else split acc start (i + 1) 118 - in 119 - split [] 0 0 120 121 (** Check if string starts with prefix *) 122 let starts_with s prefix =
··· 1 (** Autocomplete attribute validation based on HTML5 spec *) 2 3 + (* Use shared utilities from Datatype *) 4 + let is_whitespace = Datatype.is_whitespace 5 + let to_ascii_lowercase = Datatype.to_ascii_lowercase 6 7 + (** Trim whitespace from string and collapse internal whitespace *) 8 let trim_whitespace s = 9 let s = String.trim s in 10 (* Also collapse internal whitespace *) ··· 101 "impp"; 102 ] 103 104 + (** Split string on whitespace - uses shared utility *) 105 + let split_on_whitespace = Datatype.split_on_whitespace 106 107 (** Check if string starts with prefix *) 108 let starts_with s prefix =
+34 -44
lib/htmlrw_check/semantic/id_checker.ml
··· 50 else 51 None 52 53 - (** Split whitespace-separated ID references. *) 54 - let split_ids value = 55 - let rec split acc start i = 56 - if i >= String.length value then 57 - if i > start then 58 - (String.sub value start (i - start)) :: acc 59 - else 60 - acc 61 - else 62 - match value.[i] with 63 - | ' ' | '\t' | '\n' | '\r' -> 64 - let acc' = 65 - if i > start then 66 - (String.sub value start (i - start)) :: acc 67 - else 68 - acc 69 - in 70 - split acc' (i + 1) (i + 1) 71 - | _ -> 72 - split acc start (i + 1) 73 - in 74 - List.rev (split [] 0 0) 75 76 - (** Attributes that reference a single ID. *) 77 - let single_id_ref_attrs = [ 78 - "for"; (* label *) 79 - "form"; (* form-associated elements *) 80 - "list"; (* input *) 81 - "aria-activedescendant"; 82 - "popovertarget"; (* button - references popover element *) 83 - "commandfor"; (* button - references element to control *) 84 - "anchor"; (* popover - references anchor element *) 85 - ] 86 87 - (** Attributes that reference multiple IDs (space-separated). *) 88 - let multi_id_ref_attrs = [ 89 - "headers"; (* td, th *) 90 - "aria-labelledby"; 91 - "aria-describedby"; 92 - "aria-controls"; 93 - "aria-flowto"; 94 - "aria-owns"; 95 - "itemref"; 96 - ] 97 98 (** Check and store an ID attribute. *) 99 let check_id state ~element:_ ~id ~location:_ collector = ··· 161 if String.length value > 0 then 162 Hashtbl.add state.map_names value () 163 164 - | attr when List.mem attr single_id_ref_attrs -> 165 add_reference state ~referring_element:element 166 ~attribute:attr ~referenced_id:value ~location 167 168 - | attr when List.mem attr multi_id_ref_attrs -> 169 (* Split space-separated IDs and add each as a reference *) 170 let ids = split_ids value in 171 List.iter (fun id ->
··· 50 else 51 None 52 53 + (** Split whitespace-separated ID references - uses shared utility. *) 54 + let split_ids = Datatype.split_on_whitespace 55 56 + (** Attributes that reference a single ID - O(1) lookup. *) 57 + let single_id_ref_attrs = 58 + let tbl = Hashtbl.create 8 in 59 + List.iter (fun a -> Hashtbl.add tbl a ()) [ 60 + "for"; (* label *) 61 + "form"; (* form-associated elements *) 62 + "list"; (* input *) 63 + "aria-activedescendant"; 64 + "popovertarget"; (* button - references popover element *) 65 + "commandfor"; (* button - references element to control *) 66 + "anchor"; (* popover - references anchor element *) 67 + ]; 68 + tbl 69 70 + let is_single_id_ref_attr name = Hashtbl.mem single_id_ref_attrs name 71 + 72 + (** Attributes that reference multiple IDs (space-separated) - O(1) lookup. *) 73 + let multi_id_ref_attrs = 74 + let tbl = Hashtbl.create 8 in 75 + List.iter (fun a -> Hashtbl.add tbl a ()) [ 76 + "headers"; (* td, th *) 77 + "aria-labelledby"; 78 + "aria-describedby"; 79 + "aria-controls"; 80 + "aria-flowto"; 81 + "aria-owns"; 82 + "itemref"; 83 + ]; 84 + tbl 85 + 86 + let is_multi_id_ref_attr name = Hashtbl.mem multi_id_ref_attrs name 87 88 (** Check and store an ID attribute. *) 89 let check_id state ~element:_ ~id ~location:_ collector = ··· 151 if String.length value > 0 then 152 Hashtbl.add state.map_names value () 153 154 + | attr when is_single_id_ref_attr attr -> 155 add_reference state ~referring_element:element 156 ~attribute:attr ~referenced_id:value ~location 157 158 + | attr when is_multi_id_ref_attr attr -> 159 (* Split space-separated IDs and add each as a reference *) 160 let ids = split_ids value in 161 List.iter (fun id ->
+2 -22
lib/htmlrw_check/specialized/microdata_checker.ml
··· 43 Hashtbl.clear state.all_ids; 44 state.html_element_seen <- false 45 46 - (** Split whitespace-separated values. *) 47 - let split_whitespace value = 48 - let rec split acc start i = 49 - if i >= String.length value then 50 - if i > start then 51 - (String.sub value start (i - start)) :: acc 52 - else 53 - acc 54 - else 55 - match value.[i] with 56 - | ' ' | '\t' | '\n' | '\r' -> 57 - let acc' = 58 - if i > start then 59 - (String.sub value start (i - start)) :: acc 60 - else 61 - acc 62 - in 63 - split acc' (i + 1) (i + 1) 64 - | _ -> 65 - split acc start (i + 1) 66 - in 67 - List.rev (split [] 0 0) 68 69 (** Check if a string is a valid URL (contains a colon). *) 70 let is_url s =
··· 43 Hashtbl.clear state.all_ids; 44 state.html_element_seen <- false 45 46 + (** Split whitespace-separated values - uses shared utility. *) 47 + let split_whitespace = Datatype.split_on_whitespace 48 49 (** Check if a string is a valid URL (contains a colon). *) 50 let is_url s =
+4
test/test_all.ml
··· 664 files = !all_files; 665 total_passed = !total_passed; 666 total_failed = !total_failed; 667 } in 668 Report.generate_report report "html5lib_test_report.html"; 669
··· 664 files = !all_files; 665 total_passed = !total_passed; 666 total_failed = !total_failed; 667 + match_quality = None; 668 + test_type_breakdown = None; 669 + strictness_mode = None; 670 + run_timestamp = None; 671 } in 672 Report.generate_report report "html5lib_test_report.html"; 673
+4
test/test_encoding.ml
··· 184 files = List.rev !file_results; 185 total_passed = !total_passed; 186 total_failed = !total_failed; 187 } in 188 Report.generate_report report "test_encoding_report.html"; 189
··· 184 files = List.rev !file_results; 185 total_passed = !total_passed; 186 total_failed = !total_failed; 187 + match_quality = None; 188 + test_type_breakdown = None; 189 + strictness_mode = None; 190 + run_timestamp = None; 191 } in 192 Report.generate_report report "test_encoding_report.html"; 193
+4
test/test_html5lib.ml
··· 229 files = List.rev !file_results; 230 total_passed = !total_passed; 231 total_failed = !total_failed; 232 } in 233 Report.generate_report report "test_html5lib_report.html"; 234
··· 229 files = List.rev !file_results; 230 total_passed = !total_passed; 231 total_failed = !total_failed; 232 + match_quality = None; 233 + test_type_breakdown = None; 234 + strictness_mode = None; 235 + run_timestamp = None; 236 } in 237 Report.generate_report report "test_html5lib_report.html"; 238
+548 -157
test/test_report.ml
··· 1 - (* HTML Test Report Generator *) 2 3 type test_result = { 4 test_num : int; ··· 19 tests : test_result list; 20 } 21 22 type report = { 23 title : string; 24 test_type : string; 25 - description : string; (* Explanation of what this test suite validates *) 26 files : file_result list; 27 total_passed : int; 28 total_failed : int; 29 } 30 31 let html_escape s = ··· 41 ) s; 42 Buffer.contents buf 43 44 - (* No truncation - show full content for standalone reports *) 45 let truncate_string ?(max_len=10000) s = 46 if String.length s <= max_len then s 47 else String.sub s 0 max_len ^ "\n... (truncated at " ^ string_of_int max_len ^ " chars)" ··· 53 --bg-tertiary: #0f3460; 54 --text-primary: #eee; 55 --text-secondary: #aaa; 56 --accent: #e94560; 57 --success: #4ade80; 58 --failure: #f87171; 59 --border: #333; 60 } 61 62 * { box-sizing: border-box; margin: 0; padding: 0; } ··· 68 line-height: 1.6; 69 } 70 71 - .container { 72 - max-width: 1400px; 73 - margin: 0 auto; 74 - padding: 20px; 75 } 76 77 - header { 78 - background: var(--bg-secondary); 79 - padding: 20px; 80 - border-radius: 8px; 81 - margin-bottom: 20px; 82 } 83 84 - header h1 { 85 font-size: 1.5rem; 86 - margin-bottom: 10px; 87 - color: var(--accent); 88 } 89 90 - .summary { 91 display: flex; 92 gap: 20px; 93 flex-wrap: wrap; 94 align-items: center; 95 } 96 97 - .stat { 98 - padding: 8px 16px; 99 border-radius: 6px; 100 font-weight: 600; 101 } 102 103 - .stat.total { background: var(--bg-tertiary); } 104 - .stat.passed { background: rgba(74, 222, 128, 0.2); color: var(--success); } 105 - .stat.failed { background: rgba(248, 113, 113, 0.2); color: var(--failure); } 106 107 .controls { 108 display: flex; 109 - gap: 10px; 110 - margin-top: 10px; 111 flex-wrap: wrap; 112 } 113 114 input[type="search"], select { 115 - padding: 8px 12px; 116 border: 1px solid var(--border); 117 - border-radius: 6px; 118 - background: var(--bg-primary); 119 color: var(--text-primary); 120 font-size: 14px; 121 } 122 123 input[type="search"] { width: 300px; } 124 125 button { 126 - padding: 8px 16px; 127 border: none; 128 - border-radius: 6px; 129 background: var(--accent); 130 color: white; 131 cursor: pointer; 132 font-size: 14px; 133 } 134 135 - button:hover { opacity: 0.9; } 136 137 .sidebar { 138 - position: fixed; 139 - left: 0; 140 - top: 0; 141 - bottom: 0; 142 - width: 280px; 143 - background: var(--bg-secondary); 144 - border-right: 1px solid var(--border); 145 overflow-y: auto; 146 - padding: 10px; 147 - padding-top: 20px; 148 } 149 150 .sidebar-item { 151 - padding: 8px 12px; 152 - border-radius: 6px; 153 cursor: pointer; 154 display: flex; 155 justify-content: space-between; 156 align-items: center; 157 margin-bottom: 4px; 158 font-size: 14px; 159 } 160 161 .sidebar-item:hover { background: var(--bg-tertiary); } 162 .sidebar-item.active { background: var(--accent); } 163 164 - .sidebar-item .count { 165 - font-size: 12px; 166 - padding: 2px 8px; 167 - border-radius: 10px; 168 - background: var(--bg-primary); 169 } 170 171 - .sidebar-item .count.all-passed { color: var(--success); } 172 - .sidebar-item .count.has-failed { color: var(--failure); } 173 - 174 - main { 175 - margin-left: 300px; 176 - padding: 20px; 177 - padding-top: 30px; 178 } 179 180 - .intro { 181 - background: var(--bg-secondary); 182 - padding: 20px; 183 - border-radius: 8px; 184 - margin-bottom: 20px; 185 - } 186 187 .file-section { 188 - margin-bottom: 30px; 189 background: var(--bg-secondary); 190 - border-radius: 8px; 191 overflow: hidden; 192 } 193 194 .file-header { 195 - padding: 15px 20px; 196 background: var(--bg-tertiary); 197 cursor: pointer; 198 display: flex; 199 justify-content: space-between; 200 align-items: center; 201 } 202 203 .file-header h2 { 204 font-size: 1.1rem; 205 display: flex; 206 align-items: center; 207 - gap: 10px; 208 } 209 210 .file-header .toggle { 211 - font-size: 1.2rem; 212 - transition: transform 0.2s; 213 } 214 215 .file-header.collapsed .toggle { transform: rotate(-90deg); } 216 217 .file-stats { 218 display: flex; 219 - gap: 15px; 220 font-size: 14px; 221 } 222 223 - .file-stats .passed { color: var(--success); } 224 - .file-stats .failed { color: var(--failure); } 225 226 - .tests-container { 227 - padding: 10px; 228 - } 229 - 230 .tests-container.hidden { display: none; } 231 232 .test-item { 233 margin: 8px 0; 234 border: 1px solid var(--border); 235 - border-radius: 6px; 236 overflow: hidden; 237 } 238 239 .test-header { 240 - padding: 10px 15px; 241 cursor: pointer; 242 display: flex; 243 justify-content: space-between; 244 align-items: center; 245 background: var(--bg-primary); 246 } 247 248 - .test-header:hover { background: var(--bg-tertiary); } 249 250 .test-header .status { 251 width: 10px; 252 height: 10px; 253 border-radius: 50%; 254 - margin-right: 10px; 255 } 256 257 .test-header .status.passed { background: var(--success); } ··· 261 flex: 1; 262 display: flex; 263 align-items: center; 264 } 265 266 .test-header .test-num { 267 font-weight: 600; 268 - margin-right: 10px; 269 - color: var(--text-secondary); 270 } 271 272 .test-header .test-desc { ··· 275 white-space: nowrap; 276 overflow: hidden; 277 text-overflow: ellipsis; 278 - max-width: 600px; 279 } 280 281 .test-details { 282 - padding: 15px; 283 - background: var(--bg-primary); 284 border-top: 1px solid var(--border); 285 display: none; 286 } ··· 288 .test-details.visible { display: block; } 289 290 .detail-section { 291 - margin-bottom: 15px; 292 } 293 294 .detail-section h4 { 295 - font-size: 12px; 296 text-transform: uppercase; 297 - color: var(--text-secondary); 298 - margin-bottom: 8px; 299 - letter-spacing: 0.5px; 300 } 301 302 .detail-section pre { 303 background: var(--bg-secondary); 304 - padding: 12px; 305 - border-radius: 6px; 306 overflow-x: auto; 307 - font-family: 'Monaco', 'Menlo', monospace; 308 font-size: 13px; 309 white-space: pre-wrap; 310 - word-break: break-all; 311 - max-height: 300px; 312 overflow-y: auto; 313 } 314 315 .detail-row { 316 display: grid; 317 grid-template-columns: 1fr 1fr; 318 - gap: 15px; 319 } 320 321 - .detail-row.single { grid-template-columns: 1fr; } 322 323 - .meta-info { 324 - display: flex; 325 - gap: 20px; 326 - flex-wrap: wrap; 327 - font-size: 13px; 328 color: var(--text-secondary); 329 - margin-bottom: 15px; 330 } 331 332 - .meta-info span { 333 - background: var(--bg-secondary); 334 - padding: 4px 10px; 335 - border-radius: 4px; 336 } 337 338 - .diff-indicator { 339 - color: var(--failure); 340 - font-weight: bold; 341 - margin-left: 5px; 342 } 343 344 - @media (max-width: 900px) { 345 .sidebar { display: none; } 346 - main { margin-left: 0; } 347 .detail-row { grid-template-columns: 1fr; } 348 } 349 |} 350 ··· 365 e.stopPropagation(); 366 const details = this.nextElementSibling; 367 details.classList.toggle('visible'); 368 }); 369 }); 370 ··· 374 const fileId = this.dataset.file; 375 const section = document.getElementById(fileId); 376 if (section) { 377 - section.scrollIntoView({ behavior: 'smooth' }); 378 - // Expand if collapsed 379 const header = section.querySelector('.file-header'); 380 - if (header.classList.contains('collapsed')) { 381 header.click(); 382 } 383 } 384 - // Update active state 385 document.querySelectorAll('.sidebar-item').forEach(i => i.classList.remove('active')); 386 this.classList.add('active'); 387 }); ··· 396 const text = item.textContent.toLowerCase(); 397 item.style.display = text.includes(query) ? '' : 'none'; 398 }); 399 }); 400 } 401 ··· 425 document.getElementById('collapse-all')?.addEventListener('click', function() { 426 document.querySelectorAll('.file-header:not(.collapsed)').forEach(h => h.click()); 427 }); 428 }); 429 |} 430 ··· 448 | Some data -> 449 Printf.sprintf {| 450 <div class="detail-section"> 451 - <h4>Original Test Data (from .dat/.test file)</h4> 452 <pre>%s</pre> 453 </div> 454 |} (html_escape (truncate_string data)) 455 | None -> "" 456 in 457 458 - let diff_indicator = if test.success then "" else {|<span class="diff-indicator">✗</span>|} in 459 460 Printf.sprintf {| 461 <div class="test-item" data-passed="%b"> ··· 465 <span class="test-num">#%d</span> 466 <span class="test-desc">%s</span> 467 </div> 468 - <span>▼</span> 469 </div> 470 <div class="test-details"> 471 %s 472 <div class="detail-section"> 473 - <h4>Input (HTML to parse)</h4> 474 <pre>%s</pre> 475 </div> 476 <div class="detail-row"> 477 <div class="detail-section"> 478 - <h4>Expected Output%s</h4> 479 <pre>%s</pre> 480 </div> 481 <div class="detail-section"> 482 - <h4>Actual Output%s</h4> 483 <pre>%s</pre> 484 </div> 485 </div> ··· 487 </div> 488 </div> 489 |} test.success status_class test.test_num desc_escaped 490 - raw_data_html input_escaped diff_indicator expected_escaped diff_indicator actual_escaped details_html 491 492 let generate_file_html file = 493 - let file_id = String.map (fun c -> if c = '.' then '-' else c) file.filename in 494 let tests_html = String.concat "\n" (List.map generate_test_html file.tests) in 495 let collapsed = if file.failed_count = 0 then "collapsed" else "" in 496 let hidden = if file.failed_count = 0 then "hidden" else "" in ··· 500 <div class="file-header %s"> 501 <h2> 502 <span class="toggle">▼</span> 503 - %s 504 - <span style="font-weight: normal; font-size: 0.9em; color: var(--text-secondary)">(%s)</span> 505 </h2> 506 <div class="file-stats"> 507 <span class="passed">✓ %d passed</span> ··· 512 %s 513 </div> 514 </div> 515 - |} file_id collapsed file.filename file.test_type file.passed_count file.failed_count hidden tests_html 516 517 let generate_sidebar_html files = 518 String.concat "\n" (List.map (fun file -> 519 - let file_id = String.map (fun c -> if c = '.' then '-' else c) file.filename in 520 - let count_class = if file.failed_count = 0 then "all-passed" else "has-failed" in 521 Printf.sprintf {| 522 <div class="sidebar-item" data-file="file-%s"> 523 - <span>%s</span> 524 - <span class="count %s">%d/%d</span> 525 </div> 526 - |} file_id file.filename count_class file.passed_count (file.passed_count + file.failed_count) 527 ) files) 528 529 let generate_report report output_path = 530 let files_html = String.concat "\n" (List.map generate_file_html report.files) in 531 let sidebar_html = generate_sidebar_html report.files in 532 533 let html = Printf.sprintf {|<!DOCTYPE html> 534 <html lang="en"> ··· 539 <style>%s</style> 540 </head> 541 <body> 542 - <div class="sidebar"> 543 - <h3 style="padding: 10px; color: var(--text-secondary); font-size: 12px; text-transform: uppercase;">Files</h3> 544 - %s 545 - </div> 546 - 547 - <main> 548 - <header> 549 <h1>%s</h1> 550 - <p style="color: var(--text-secondary); margin: 10px 0; max-width: 900px;">%s</p> 551 - <div class="summary"> 552 - <span class="stat total">%d tests</span> 553 - <span class="stat passed">✓ %d passed</span> 554 - <span class="stat failed">✗ %d failed</span> 555 - <span class="stat total">%.1f%% pass rate</span> 556 </div> 557 - <div class="controls"> 558 - <input type="search" id="search" placeholder="Search tests..."> 559 - <select id="filter"> 560 - <option value="all">All tests</option> 561 - <option value="passed">Passed only</option> 562 - <option value="failed">Failed only</option> 563 - </select> 564 - <button id="expand-all">Expand All</button> 565 - <button id="collapse-all">Collapse All</button> 566 </div> 567 - </header> 568 %s 569 - </main> 570 571 <script>%s</script> 572 </body> 573 </html> 574 |} report.title css 575 - sidebar_html 576 report.title (html_escape report.description) 577 - (report.total_passed + report.total_failed) 578 - report.total_passed 579 report.total_failed 580 - (100.0 *. float_of_int report.total_passed /. float_of_int (max 1 (report.total_passed + report.total_failed))) 581 - files_html js 582 in 583 584 let oc = open_out output_path in
··· 1 + (* HTML Test Report Generator - Standalone HTML reports for test results *) 2 3 type test_result = { 4 test_num : int; ··· 19 tests : test_result list; 20 } 21 22 + type match_quality_stats = { 23 + exact_matches : int; 24 + code_matches : int; 25 + message_matches : int; 26 + substring_matches : int; 27 + severity_mismatches : int; 28 + no_matches : int; 29 + not_applicable : int; 30 + } 31 + 32 + type test_type_stats = { 33 + isvalid_passed : int; 34 + isvalid_total : int; 35 + novalid_passed : int; 36 + novalid_total : int; 37 + haswarn_passed : int; 38 + haswarn_total : int; 39 + } 40 + 41 type report = { 42 title : string; 43 test_type : string; 44 + description : string; 45 files : file_result list; 46 total_passed : int; 47 total_failed : int; 48 + match_quality : match_quality_stats option; 49 + test_type_breakdown : test_type_stats option; 50 + strictness_mode : string option; 51 + run_timestamp : string option; 52 } 53 54 let html_escape s = ··· 64 ) s; 65 Buffer.contents buf 66 67 let truncate_string ?(max_len=10000) s = 68 if String.length s <= max_len then s 69 else String.sub s 0 max_len ^ "\n... (truncated at " ^ string_of_int max_len ^ " chars)" ··· 75 --bg-tertiary: #0f3460; 76 --text-primary: #eee; 77 --text-secondary: #aaa; 78 + --text-muted: #666; 79 --accent: #e94560; 80 + --accent-light: #ff6b8a; 81 --success: #4ade80; 82 + --success-dim: rgba(74, 222, 128, 0.2); 83 --failure: #f87171; 84 + --failure-dim: rgba(248, 113, 113, 0.2); 85 + --warning: #fbbf24; 86 + --info: #60a5fa; 87 --border: #333; 88 + --code-bg: #0d1117; 89 } 90 91 * { box-sizing: border-box; margin: 0; padding: 0; } ··· 97 line-height: 1.6; 98 } 99 100 + .container { max-width: 1600px; margin: 0 auto; padding: 20px; } 101 + 102 + /* Hero Header */ 103 + .hero { 104 + background: linear-gradient(135deg, var(--bg-secondary) 0%, var(--bg-tertiary) 100%); 105 + padding: 40px; 106 + border-radius: 12px; 107 + margin-bottom: 30px; 108 + border: 1px solid var(--border); 109 } 110 111 + .hero h1 { 112 + font-size: 2rem; 113 + margin-bottom: 15px; 114 + color: var(--accent); 115 + display: flex; 116 + align-items: center; 117 + gap: 15px; 118 } 119 120 + .hero h1::before { 121 + content: "🧪"; 122 font-size: 1.5rem; 123 } 124 125 + .hero-description { 126 + color: var(--text-secondary); 127 + max-width: 900px; 128 + margin-bottom: 20px; 129 + font-size: 1.05rem; 130 + } 131 + 132 + .hero-meta { 133 display: flex; 134 gap: 20px; 135 flex-wrap: wrap; 136 + font-size: 0.9rem; 137 + color: var(--text-muted); 138 + } 139 + 140 + .hero-meta span { 141 + display: flex; 142 align-items: center; 143 + gap: 6px; 144 + } 145 + 146 + /* Summary Cards */ 147 + .summary-grid { 148 + display: grid; 149 + grid-template-columns: repeat(auto-fit, minmax(200px, 1fr)); 150 + gap: 20px; 151 + margin-bottom: 30px; 152 } 153 154 + .summary-card { 155 + background: var(--bg-secondary); 156 + border-radius: 12px; 157 + padding: 24px; 158 + border: 1px solid var(--border); 159 + text-align: center; 160 + } 161 + 162 + .summary-card.large { 163 + grid-column: span 2; 164 + } 165 + 166 + .summary-card h3 { 167 + font-size: 0.85rem; 168 + text-transform: uppercase; 169 + letter-spacing: 1px; 170 + color: var(--text-secondary); 171 + margin-bottom: 10px; 172 + } 173 + 174 + .summary-card .value { 175 + font-size: 2.5rem; 176 + font-weight: 700; 177 + line-height: 1.2; 178 + } 179 + 180 + .summary-card .value.success { color: var(--success); } 181 + .summary-card .value.failure { color: var(--failure); } 182 + .summary-card .value.neutral { color: var(--text-primary); } 183 + 184 + .summary-card .subtext { 185 + font-size: 0.85rem; 186 + color: var(--text-muted); 187 + margin-top: 5px; 188 + } 189 + 190 + /* Progress Bar */ 191 + .progress-bar { 192 + height: 12px; 193 + background: var(--failure-dim); 194 border-radius: 6px; 195 + overflow: hidden; 196 + margin-top: 15px; 197 + } 198 + 199 + .progress-fill { 200 + height: 100%; 201 + background: var(--success); 202 + border-radius: 6px; 203 + transition: width 0.5s ease; 204 + } 205 + 206 + /* Stats Breakdown */ 207 + .stats-section { 208 + background: var(--bg-secondary); 209 + border-radius: 12px; 210 + padding: 24px; 211 + margin-bottom: 30px; 212 + border: 1px solid var(--border); 213 + } 214 + 215 + .stats-section h2 { 216 + font-size: 1.2rem; 217 + margin-bottom: 20px; 218 + color: var(--accent-light); 219 + display: flex; 220 + align-items: center; 221 + gap: 10px; 222 + } 223 + 224 + .stats-grid { 225 + display: grid; 226 + grid-template-columns: repeat(auto-fit, minmax(180px, 1fr)); 227 + gap: 15px; 228 + } 229 + 230 + .stat-item { 231 + background: var(--bg-primary); 232 + padding: 16px; 233 + border-radius: 8px; 234 + display: flex; 235 + justify-content: space-between; 236 + align-items: center; 237 + } 238 + 239 + .stat-item .label { 240 + font-size: 0.9rem; 241 + color: var(--text-secondary); 242 + } 243 + 244 + .stat-item .count { 245 + font-size: 1.4rem; 246 font-weight: 600; 247 } 248 249 + .stat-item.success .count { color: var(--success); } 250 + .stat-item.failure .count { color: var(--failure); } 251 + .stat-item.warning .count { color: var(--warning); } 252 + .stat-item.info .count { color: var(--info); } 253 254 + /* Controls */ 255 .controls { 256 display: flex; 257 + gap: 12px; 258 + margin-bottom: 25px; 259 flex-wrap: wrap; 260 + align-items: center; 261 } 262 263 input[type="search"], select { 264 + padding: 10px 14px; 265 border: 1px solid var(--border); 266 + border-radius: 8px; 267 + background: var(--bg-secondary); 268 color: var(--text-primary); 269 font-size: 14px; 270 } 271 272 input[type="search"] { width: 300px; } 273 + input[type="search"]:focus, select:focus { 274 + outline: none; 275 + border-color: var(--accent); 276 + } 277 278 button { 279 + padding: 10px 18px; 280 border: none; 281 + border-radius: 8px; 282 background: var(--accent); 283 color: white; 284 cursor: pointer; 285 font-size: 14px; 286 + font-weight: 500; 287 + transition: all 0.2s; 288 } 289 290 + button:hover { background: var(--accent-light); } 291 + button.secondary { 292 + background: var(--bg-tertiary); 293 + border: 1px solid var(--border); 294 + } 295 + button.secondary:hover { background: var(--bg-secondary); } 296 + 297 + /* Sidebar */ 298 + .layout { 299 + display: grid; 300 + grid-template-columns: 280px 1fr; 301 + gap: 30px; 302 + } 303 304 .sidebar { 305 + position: sticky; 306 + top: 20px; 307 + height: fit-content; 308 + max-height: calc(100vh - 40px); 309 overflow-y: auto; 310 + background: var(--bg-secondary); 311 + border-radius: 12px; 312 + padding: 16px; 313 + border: 1px solid var(--border); 314 + } 315 + 316 + .sidebar h3 { 317 + font-size: 0.75rem; 318 + text-transform: uppercase; 319 + letter-spacing: 1px; 320 + color: var(--text-muted); 321 + margin-bottom: 12px; 322 + padding: 0 8px; 323 } 324 325 .sidebar-item { 326 + padding: 10px 12px; 327 + border-radius: 8px; 328 cursor: pointer; 329 display: flex; 330 justify-content: space-between; 331 align-items: center; 332 margin-bottom: 4px; 333 font-size: 14px; 334 + transition: all 0.2s; 335 } 336 337 .sidebar-item:hover { background: var(--bg-tertiary); } 338 .sidebar-item.active { background: var(--accent); } 339 340 + .sidebar-item .name { 341 + white-space: nowrap; 342 + overflow: hidden; 343 + text-overflow: ellipsis; 344 + max-width: 160px; 345 } 346 347 + .sidebar-item .badge { 348 + font-size: 11px; 349 + padding: 3px 8px; 350 + border-radius: 12px; 351 + background: var(--bg-primary); 352 + font-weight: 600; 353 } 354 355 + .sidebar-item .badge.all-passed { color: var(--success); } 356 + .sidebar-item .badge.has-failed { color: var(--failure); } 357 358 + /* File Sections */ 359 .file-section { 360 + margin-bottom: 24px; 361 background: var(--bg-secondary); 362 + border-radius: 12px; 363 overflow: hidden; 364 + border: 1px solid var(--border); 365 } 366 367 .file-header { 368 + padding: 18px 24px; 369 background: var(--bg-tertiary); 370 cursor: pointer; 371 display: flex; 372 justify-content: space-between; 373 align-items: center; 374 + transition: background 0.2s; 375 } 376 + 377 + .file-header:hover { background: #1a4a7a; } 378 379 .file-header h2 { 380 font-size: 1.1rem; 381 display: flex; 382 align-items: center; 383 + gap: 12px; 384 } 385 386 .file-header .toggle { 387 + font-size: 1rem; 388 + transition: transform 0.3s; 389 + color: var(--text-secondary); 390 } 391 392 .file-header.collapsed .toggle { transform: rotate(-90deg); } 393 394 .file-stats { 395 display: flex; 396 + gap: 20px; 397 font-size: 14px; 398 } 399 400 + .file-stats .passed { color: var(--success); font-weight: 500; } 401 + .file-stats .failed { color: var(--failure); font-weight: 500; } 402 403 + .tests-container { padding: 12px; } 404 .tests-container.hidden { display: none; } 405 406 + /* Test Items */ 407 .test-item { 408 margin: 8px 0; 409 border: 1px solid var(--border); 410 + border-radius: 8px; 411 overflow: hidden; 412 + transition: border-color 0.2s; 413 } 414 415 + .test-item:hover { border-color: var(--text-muted); } 416 + 417 .test-header { 418 + padding: 12px 16px; 419 cursor: pointer; 420 display: flex; 421 justify-content: space-between; 422 align-items: center; 423 background: var(--bg-primary); 424 + transition: background 0.2s; 425 } 426 427 + .test-header:hover { background: rgba(255,255,255,0.03); } 428 429 .test-header .status { 430 width: 10px; 431 height: 10px; 432 border-radius: 50%; 433 + margin-right: 12px; 434 + flex-shrink: 0; 435 } 436 437 .test-header .status.passed { background: var(--success); } ··· 441 flex: 1; 442 display: flex; 443 align-items: center; 444 + min-width: 0; 445 } 446 447 .test-header .test-num { 448 font-weight: 600; 449 + margin-right: 12px; 450 + color: var(--text-muted); 451 + font-size: 0.9rem; 452 } 453 454 .test-header .test-desc { ··· 457 white-space: nowrap; 458 overflow: hidden; 459 text-overflow: ellipsis; 460 + } 461 + 462 + .test-header .expand-icon { 463 + color: var(--text-muted); 464 + font-size: 0.8rem; 465 } 466 467 + /* Test Details */ 468 .test-details { 469 + padding: 20px; 470 + background: var(--code-bg); 471 border-top: 1px solid var(--border); 472 display: none; 473 } ··· 475 .test-details.visible { display: block; } 476 477 .detail-section { 478 + margin-bottom: 20px; 479 } 480 + 481 + .detail-section:last-child { margin-bottom: 0; } 482 483 .detail-section h4 { 484 + font-size: 11px; 485 text-transform: uppercase; 486 + letter-spacing: 1px; 487 + color: var(--text-muted); 488 + margin-bottom: 10px; 489 + display: flex; 490 + align-items: center; 491 + gap: 8px; 492 } 493 494 .detail-section pre { 495 background: var(--bg-secondary); 496 + padding: 16px; 497 + border-radius: 8px; 498 overflow-x: auto; 499 + font-family: 'Monaco', 'Menlo', 'Consolas', monospace; 500 font-size: 13px; 501 white-space: pre-wrap; 502 + word-break: break-word; 503 + max-height: 400px; 504 overflow-y: auto; 505 + line-height: 1.5; 506 + border: 1px solid var(--border); 507 } 508 509 .detail-row { 510 display: grid; 511 grid-template-columns: 1fr 1fr; 512 + gap: 20px; 513 } 514 515 + .comparison-label { 516 + display: inline-block; 517 + padding: 2px 8px; 518 + border-radius: 4px; 519 + font-size: 10px; 520 + font-weight: 600; 521 + margin-left: 8px; 522 + } 523 524 + .comparison-label.match { background: var(--success-dim); color: var(--success); } 525 + .comparison-label.mismatch { background: var(--failure-dim); color: var(--failure); } 526 + 527 + /* Explanation Section */ 528 + .explanation { 529 + background: var(--bg-secondary); 530 + border-radius: 12px; 531 + padding: 24px; 532 + margin-bottom: 30px; 533 + border: 1px solid var(--border); 534 + } 535 + 536 + .explanation h2 { 537 + font-size: 1.2rem; 538 + margin-bottom: 16px; 539 + color: var(--accent-light); 540 + } 541 + 542 + .explanation p { 543 color: var(--text-secondary); 544 + margin-bottom: 12px; 545 } 546 547 + .explanation ul { 548 + list-style: none; 549 + padding-left: 0; 550 } 551 552 + .explanation li { 553 + padding: 8px 0; 554 + padding-left: 24px; 555 + position: relative; 556 + color: var(--text-secondary); 557 } 558 559 + .explanation li::before { 560 + content: "→"; 561 + position: absolute; 562 + left: 0; 563 + color: var(--accent); 564 + } 565 + 566 + .explanation code { 567 + background: var(--bg-primary); 568 + padding: 2px 6px; 569 + border-radius: 4px; 570 + font-family: monospace; 571 + font-size: 0.9em; 572 + color: var(--accent-light); 573 + } 574 + 575 + @media (max-width: 1000px) { 576 + .layout { grid-template-columns: 1fr; } 577 .sidebar { display: none; } 578 .detail-row { grid-template-columns: 1fr; } 579 + .summary-card.large { grid-column: span 1; } 580 } 581 |} 582 ··· 597 e.stopPropagation(); 598 const details = this.nextElementSibling; 599 details.classList.toggle('visible'); 600 + const icon = this.querySelector('.expand-icon'); 601 + if (icon) icon.textContent = details.classList.contains('visible') ? '▲' : '▼'; 602 }); 603 }); 604 ··· 608 const fileId = this.dataset.file; 609 const section = document.getElementById(fileId); 610 if (section) { 611 + section.scrollIntoView({ behavior: 'smooth', block: 'start' }); 612 const header = section.querySelector('.file-header'); 613 + if (header && header.classList.contains('collapsed')) { 614 header.click(); 615 } 616 } 617 document.querySelectorAll('.sidebar-item').forEach(i => i.classList.remove('active')); 618 this.classList.add('active'); 619 }); ··· 628 const text = item.textContent.toLowerCase(); 629 item.style.display = text.includes(query) ? '' : 'none'; 630 }); 631 + // Update counts 632 + document.querySelectorAll('.file-section').forEach(section => { 633 + const visible = section.querySelectorAll('.test-item:not([style*="display: none"])').length; 634 + const total = section.querySelectorAll('.test-item').length; 635 + if (visible === 0 && query) { 636 + section.style.display = 'none'; 637 + } else { 638 + section.style.display = ''; 639 + } 640 + }); 641 }); 642 } 643 ··· 667 document.getElementById('collapse-all')?.addEventListener('click', function() { 668 document.querySelectorAll('.file-header:not(.collapsed)').forEach(h => h.click()); 669 }); 670 + 671 + // Show only failed 672 + document.getElementById('show-failed')?.addEventListener('click', function() { 673 + document.getElementById('filter').value = 'failed'; 674 + document.getElementById('filter').dispatchEvent(new Event('change')); 675 + }); 676 }); 677 |} 678 ··· 696 | Some data -> 697 Printf.sprintf {| 698 <div class="detail-section"> 699 + <h4>📄 Source HTML</h4> 700 <pre>%s</pre> 701 </div> 702 |} (html_escape (truncate_string data)) 703 | None -> "" 704 in 705 706 + let comparison_label = if test.success then 707 + {|<span class="comparison-label match">MATCH</span>|} 708 + else 709 + {|<span class="comparison-label mismatch">MISMATCH</span>|} 710 + in 711 712 Printf.sprintf {| 713 <div class="test-item" data-passed="%b"> ··· 717 <span class="test-num">#%d</span> 718 <span class="test-desc">%s</span> 719 </div> 720 + <span class="expand-icon">▼</span> 721 </div> 722 <div class="test-details"> 723 %s 724 <div class="detail-section"> 725 + <h4>📥 Input File</h4> 726 <pre>%s</pre> 727 </div> 728 <div class="detail-row"> 729 <div class="detail-section"> 730 + <h4>✓ Expected Output</h4> 731 <pre>%s</pre> 732 </div> 733 <div class="detail-section"> 734 + <h4>⚡ Actual Output %s</h4> 735 <pre>%s</pre> 736 </div> 737 </div> ··· 739 </div> 740 </div> 741 |} test.success status_class test.test_num desc_escaped 742 + raw_data_html input_escaped expected_escaped comparison_label actual_escaped details_html 743 744 let generate_file_html file = 745 + let file_id = String.map (fun c -> if c = '/' || c = '.' then '-' else c) file.filename in 746 let tests_html = String.concat "\n" (List.map generate_test_html file.tests) in 747 let collapsed = if file.failed_count = 0 then "collapsed" else "" in 748 let hidden = if file.failed_count = 0 then "hidden" else "" in ··· 752 <div class="file-header %s"> 753 <h2> 754 <span class="toggle">▼</span> 755 + 📁 %s 756 </h2> 757 <div class="file-stats"> 758 <span class="passed">✓ %d passed</span> ··· 763 %s 764 </div> 765 </div> 766 + |} file_id collapsed file.filename file.passed_count file.failed_count hidden tests_html 767 768 let generate_sidebar_html files = 769 String.concat "\n" (List.map (fun file -> 770 + let file_id = String.map (fun c -> if c = '/' || c = '.' then '-' else c) file.filename in 771 + let badge_class = if file.failed_count = 0 then "all-passed" else "has-failed" in 772 Printf.sprintf {| 773 <div class="sidebar-item" data-file="file-%s"> 774 + <span class="name">%s</span> 775 + <span class="badge %s">%d/%d</span> 776 </div> 777 + |} file_id file.filename badge_class file.passed_count (file.passed_count + file.failed_count) 778 ) files) 779 780 + let generate_match_quality_html stats = 781 + Printf.sprintf {| 782 + <div class="stats-section"> 783 + <h2>📊 Match Quality Breakdown</h2> 784 + <div class="stats-grid"> 785 + <div class="stat-item success"> 786 + <span class="label">Exact Matches</span> 787 + <span class="count">%d</span> 788 + </div> 789 + <div class="stat-item success"> 790 + <span class="label">Code Matches</span> 791 + <span class="count">%d</span> 792 + </div> 793 + <div class="stat-item info"> 794 + <span class="label">Message Matches</span> 795 + <span class="count">%d</span> 796 + </div> 797 + <div class="stat-item warning"> 798 + <span class="label">Substring Matches</span> 799 + <span class="count">%d</span> 800 + </div> 801 + <div class="stat-item warning"> 802 + <span class="label">Severity Mismatches</span> 803 + <span class="count">%d</span> 804 + </div> 805 + <div class="stat-item failure"> 806 + <span class="label">No Matches</span> 807 + <span class="count">%d</span> 808 + </div> 809 + <div class="stat-item"> 810 + <span class="label">N/A (isvalid tests)</span> 811 + <span class="count">%d</span> 812 + </div> 813 + </div> 814 + </div> 815 + |} stats.exact_matches stats.code_matches stats.message_matches 816 + stats.substring_matches stats.severity_mismatches stats.no_matches stats.not_applicable 817 + 818 + let generate_test_type_html stats = 819 + let pct a b = if b = 0 then 0.0 else 100.0 *. float_of_int a /. float_of_int b in 820 + Printf.sprintf {| 821 + <div class="stats-section"> 822 + <h2>📋 Results by Test Type</h2> 823 + <div class="stats-grid"> 824 + <div class="stat-item %s"> 825 + <span class="label">isvalid (no errors expected)</span> 826 + <span class="count">%d/%d (%.1f%%)</span> 827 + </div> 828 + <div class="stat-item %s"> 829 + <span class="label">novalid (errors expected)</span> 830 + <span class="count">%d/%d (%.1f%%)</span> 831 + </div> 832 + <div class="stat-item %s"> 833 + <span class="label">haswarn (warnings expected)</span> 834 + <span class="count">%d/%d (%.1f%%)</span> 835 + </div> 836 + </div> 837 + </div> 838 + |} 839 + (if stats.isvalid_passed = stats.isvalid_total then "success" else "failure") 840 + stats.isvalid_passed stats.isvalid_total (pct stats.isvalid_passed stats.isvalid_total) 841 + (if stats.novalid_passed = stats.novalid_total then "success" else "failure") 842 + stats.novalid_passed stats.novalid_total (pct stats.novalid_passed stats.novalid_total) 843 + (if stats.haswarn_passed = stats.haswarn_total then "success" else "failure") 844 + stats.haswarn_passed stats.haswarn_total (pct stats.haswarn_passed stats.haswarn_total) 845 + 846 let generate_report report output_path = 847 let files_html = String.concat "\n" (List.map generate_file_html report.files) in 848 let sidebar_html = generate_sidebar_html report.files in 849 + let total = report.total_passed + report.total_failed in 850 + let pass_rate = if total = 0 then 0.0 else 100.0 *. float_of_int report.total_passed /. float_of_int total in 851 + 852 + let match_quality_html = match report.match_quality with 853 + | Some stats -> generate_match_quality_html stats 854 + | None -> "" 855 + in 856 + 857 + let test_type_html = match report.test_type_breakdown with 858 + | Some stats -> generate_test_type_html stats 859 + | None -> "" 860 + in 861 + 862 + let mode_text = match report.strictness_mode with 863 + | Some m -> Printf.sprintf " (Mode: %s)" m 864 + | None -> "" 865 + in 866 + 867 + let timestamp_text = match report.run_timestamp with 868 + | Some t -> Printf.sprintf "<span>🕐 %s</span>" (html_escape t) 869 + | None -> "" 870 + in 871 872 let html = Printf.sprintf {|<!DOCTYPE html> 873 <html lang="en"> ··· 878 <style>%s</style> 879 </head> 880 <body> 881 + <div class="container"> 882 + <div class="hero"> 883 <h1>%s</h1> 884 + <p class="hero-description">%s</p> 885 + <div class="hero-meta"> 886 + <span>📊 %d total tests</span> 887 + <span>✓ %d passed</span> 888 + <span>✗ %d failed</span> 889 + %s 890 </div> 891 + </div> 892 + 893 + <div class="summary-grid"> 894 + <div class="summary-card large"> 895 + <h3>Overall Pass Rate%s</h3> 896 + <div class="value %s">%.1f%%</div> 897 + <div class="progress-bar"> 898 + <div class="progress-fill" style="width: %.1f%%"></div> 899 + </div> 900 </div> 901 + <div class="summary-card"> 902 + <h3>Tests Passed</h3> 903 + <div class="value success">%d</div> 904 + <div class="subtext">out of %d tests</div> 905 + </div> 906 + <div class="summary-card"> 907 + <h3>Tests Failed</h3> 908 + <div class="value %s">%d</div> 909 + <div class="subtext">%s</div> 910 + </div> 911 + <div class="summary-card"> 912 + <h3>Categories</h3> 913 + <div class="value neutral">%d</div> 914 + <div class="subtext">test categories</div> 915 + </div> 916 + </div> 917 + 918 %s 919 + %s 920 + 921 + <div class="explanation"> 922 + <h2>📖 About This Test Run</h2> 923 + <p>This report shows the results of running the <strong>%s</strong> test suite against the HTML5 validator implementation.</p> 924 + <p>Tests are organized by category and classified by their expected outcome:</p> 925 + <ul> 926 + <li><code>-isvalid.html</code> — Valid HTML that should produce <strong>no errors or warnings</strong></li> 927 + <li><code>-novalid.html</code> — Invalid HTML that should produce <strong>at least one error</strong></li> 928 + <li><code>-haswarn.html</code> — HTML that should produce <strong>at least one warning</strong></li> 929 + </ul> 930 + <p>Click on any test to expand its details and see the input HTML, expected output, and actual validator messages.</p> 931 + </div> 932 + 933 + <div class="controls"> 934 + <input type="search" id="search" placeholder="🔍 Search tests by name or content..."> 935 + <select id="filter"> 936 + <option value="all">All tests</option> 937 + <option value="passed">Passed only</option> 938 + <option value="failed">Failed only</option> 939 + </select> 940 + <button id="show-failed" class="secondary">Show Failed Only</button> 941 + <button id="expand-all" class="secondary">Expand All</button> 942 + <button id="collapse-all" class="secondary">Collapse All</button> 943 + </div> 944 + 945 + <div class="layout"> 946 + <div class="sidebar"> 947 + <h3>Categories</h3> 948 + %s 949 + </div> 950 + <div class="main-content"> 951 + %s 952 + </div> 953 + </div> 954 + </div> 955 956 <script>%s</script> 957 </body> 958 </html> 959 |} report.title css 960 report.title (html_escape report.description) 961 + total report.total_passed report.total_failed timestamp_text 962 + mode_text 963 + (if pass_rate >= 99.0 then "success" else if pass_rate >= 90.0 then "neutral" else "failure") 964 + pass_rate pass_rate 965 + report.total_passed total 966 + (if report.total_failed = 0 then "success" else "failure") 967 report.total_failed 968 + (if report.total_failed = 0 then "Perfect score!" else "needs attention") 969 + (List.length report.files) 970 + test_type_html match_quality_html 971 + report.title 972 + sidebar_html files_html js 973 in 974 975 let oc = open_out output_path in
+4
test/test_serializer.ml
··· 846 files = List.rev !file_results; 847 total_passed = !total_passed; 848 total_failed = !total_failed; 849 } in 850 Report.generate_report report "test_serializer_report.html"; 851
··· 846 files = List.rev !file_results; 847 total_passed = !total_passed; 848 total_failed = !total_failed; 849 + match_quality = None; 850 + test_type_breakdown = None; 851 + strictness_mode = None; 852 + run_timestamp = None; 853 } in 854 Report.generate_report report "test_serializer_report.html"; 855
+4
test/test_tokenizer.ml
··· 396 files = List.rev !file_results; 397 total_passed = !total_passed; 398 total_failed = !total_failed; 399 } in 400 Report.generate_report report "test_tokenizer_report.html"; 401
··· 396 files = List.rev !file_results; 397 total_passed = !total_passed; 398 total_failed = !total_failed; 399 + match_quality = None; 400 + test_type_breakdown = None; 401 + strictness_mode = None; 402 + run_timestamp = None; 403 } in 404 Report.generate_report report "test_tokenizer_report.html"; 405
+79 -12
test/test_validator.ml
··· 269 Printf.printf "No matches: %d\n" no_match; 270 Printf.printf "N/A (isvalid or no expected): %d\n" no_quality 271 272 (** Generate HTML report *) 273 let generate_html_report results output_path = 274 let by_category = group_by_category results in ··· 278 let failed_count = List.length tests - passed_count in 279 let test_results = List.mapi (fun i r -> 280 let outcome_str = match r.file.expected with 281 - | Valid -> "valid" 282 - | Invalid -> "invalid" 283 - | HasWarning -> "has-warning" 284 | Unknown -> "unknown" 285 in 286 - let description = Printf.sprintf "[%s] %s" outcome_str r.file.relative_path in 287 let expected = match r.expected_message with 288 | Some m -> m 289 - | None -> "(no expected message)" 290 in 291 let actual_str = 292 let errors = if r.actual_errors = [] then "" 293 - else "Errors:\n" ^ String.concat "\n" r.actual_errors in 294 let warnings = if r.actual_warnings = [] then "" 295 - else "Warnings:\n" ^ String.concat "\n" r.actual_warnings in 296 let infos = if r.actual_infos = [] then "" 297 - else "Info:\n" ^ String.concat "\n" r.actual_infos in 298 - if errors = "" && warnings = "" && infos = "" then "(no messages)" 299 - else String.trim (errors ^ "\n" ^ warnings ^ "\n" ^ infos) 300 in 301 Report.{ 302 test_num = i + 1; ··· 305 expected; 306 actual = actual_str; 307 success = r.passed; 308 - details = [("Status", r.details)]; 309 - raw_test_data = None; 310 } 311 ) tests in 312 Report.{ ··· 321 let total_passed = List.filter (fun r -> r.passed) results |> List.length in 322 let total_failed = List.length results - total_passed in 323 324 let report : Report.report = { 325 title = "Nu HTML Validator Tests"; 326 test_type = "validator"; ··· 332 files = file_results; 333 total_passed; 334 total_failed; 335 } in 336 Report.generate_report report output_path 337
··· 269 Printf.printf "No matches: %d\n" no_match; 270 Printf.printf "N/A (isvalid or no expected): %d\n" no_quality 271 272 + (** Read HTML source file for display in report *) 273 + let read_html_source path = 274 + try 275 + let ic = open_in path in 276 + let content = really_input_string ic (in_channel_length ic) in 277 + close_in ic; 278 + Some content 279 + with _ -> None 280 + 281 (** Generate HTML report *) 282 let generate_html_report results output_path = 283 let by_category = group_by_category results in ··· 287 let failed_count = List.length tests - passed_count in 288 let test_results = List.mapi (fun i r -> 289 let outcome_str = match r.file.expected with 290 + | Valid -> "isvalid" 291 + | Invalid -> "novalid" 292 + | HasWarning -> "haswarn" 293 | Unknown -> "unknown" 294 in 295 + let description = Printf.sprintf "[%s] %s" outcome_str (Filename.basename r.file.relative_path) in 296 let expected = match r.expected_message with 297 | Some m -> m 298 + | None -> match r.file.expected with 299 + | Valid -> "(should produce no errors or warnings)" 300 + | Invalid -> "(should produce at least one error)" 301 + | HasWarning -> "(should produce at least one warning)" 302 + | Unknown -> "(unknown test type)" 303 in 304 let actual_str = 305 let errors = if r.actual_errors = [] then "" 306 + else "Errors:\n • " ^ String.concat "\n • " r.actual_errors in 307 let warnings = if r.actual_warnings = [] then "" 308 + else "Warnings:\n • " ^ String.concat "\n • " r.actual_warnings in 309 let infos = if r.actual_infos = [] then "" 310 + else "Info:\n • " ^ String.concat "\n • " r.actual_infos in 311 + if errors = "" && warnings = "" && infos = "" then "(no messages produced)" 312 + else String.trim (errors ^ (if errors <> "" && warnings <> "" then "\n\n" else "") ^ 313 + warnings ^ (if (errors <> "" || warnings <> "") && infos <> "" then "\n\n" else "") ^ 314 + infos) 315 + in 316 + let match_quality_str = match r.match_quality with 317 + | Some q -> Expected_message.match_quality_to_string q 318 + | None -> "N/A" 319 in 320 Report.{ 321 test_num = i + 1; ··· 324 expected; 325 actual = actual_str; 326 success = r.passed; 327 + details = [ 328 + ("Result", r.details); 329 + ("Match Quality", match_quality_str); 330 + ]; 331 + raw_test_data = read_html_source r.file.path; 332 } 333 ) tests in 334 Report.{ ··· 343 let total_passed = List.filter (fun r -> r.passed) results |> List.length in 344 let total_failed = List.length results - total_passed in 345 346 + (* Compute match quality stats *) 347 + let count_quality q = List.filter (fun r -> 348 + match r.match_quality with Some mq -> mq = q | None -> false 349 + ) results |> List.length in 350 + let match_quality_stats : Report.match_quality_stats = { 351 + exact_matches = count_quality Expected_message.Exact_match; 352 + code_matches = count_quality Expected_message.Code_match; 353 + message_matches = count_quality Expected_message.Message_match; 354 + substring_matches = count_quality Expected_message.Substring_match; 355 + severity_mismatches = count_quality Expected_message.Severity_mismatch; 356 + no_matches = count_quality Expected_message.No_match; 357 + not_applicable = List.filter (fun r -> r.match_quality = None) results |> List.length; 358 + } in 359 + 360 + (* Compute test type stats *) 361 + let isvalid_results = List.filter (fun r -> r.file.expected = Valid) results in 362 + let novalid_results = List.filter (fun r -> r.file.expected = Invalid) results in 363 + let haswarn_results = List.filter (fun r -> r.file.expected = HasWarning) results in 364 + let count_passed rs = List.filter (fun r -> r.passed) rs |> List.length in 365 + let test_type_stats : Report.test_type_stats = { 366 + isvalid_passed = count_passed isvalid_results; 367 + isvalid_total = List.length isvalid_results; 368 + novalid_passed = count_passed novalid_results; 369 + novalid_total = List.length novalid_results; 370 + haswarn_passed = count_passed haswarn_results; 371 + haswarn_total = List.length haswarn_results; 372 + } in 373 + 374 + let mode_name = 375 + if !strictness = Expected_message.strict then "STRICT (full)" 376 + else if !strictness = Expected_message.exact_message then "STRICT (exact message)" 377 + else "lenient" 378 + in 379 + 380 + (* Get current timestamp *) 381 + let now = Unix.gettimeofday () in 382 + let tm = Unix.localtime now in 383 + let timestamp = Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" 384 + (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday 385 + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in 386 + 387 let report : Report.report = { 388 title = "Nu HTML Validator Tests"; 389 test_type = "validator"; ··· 395 files = file_results; 396 total_passed; 397 total_failed; 398 + match_quality = Some match_quality_stats; 399 + test_type_breakdown = Some test_type_stats; 400 + strictness_mode = Some mode_name; 401 + run_timestamp = Some timestamp; 402 } in 403 Report.generate_report report output_path 404