more

dune-project

···
   (uutf (>= 1.0.0))
   (uuuu (>= 0.3.0))
   (uunf (>= 15.0.0))
+  (xmlm (>= 1.4.0))
   (odoc :with-doc)
   (jsont (>= 0.2.0))
   (cmdliner (>= 1.3.0))))

html5rw.opam

···
   "uutf" {>= "1.0.0"}
   "uuuu" {>= "0.3.0"}
   "uunf" {>= "15.0.0"}
+  "xmlm" {>= "1.4.0"}
   "odoc" {with-doc}
   "jsont" {>= "0.2.0"}
   "cmdliner" {>= "1.3.0"}

lib/html5_checker/checker_registry.ml

···
   Hashtbl.replace reg "table" Table_checker.checker;
   Hashtbl.replace reg "mime-type" Mime_type_checker.checker;
   Hashtbl.replace reg "normalization" Normalization_checker.checker;
+  Hashtbl.replace reg "svg" Svg_checker.checker;
   (* Hashtbl.replace reg "heading" Heading_checker.checker; *)
   (* Hashtbl.replace reg "content" Content_checker.checker; *)
   reg

lib/html5_checker/specialized/svg_checker.ml

···
+(** SVG attribute and element validation checker.
+
+    Validates SVG elements and attributes according to SVG 1.1/2 specifications. *)
+
+type state = {
+  mutable in_svg : bool;
+  mutable element_stack : string list;
+}
+
+let create () = { in_svg = false; element_stack = [] }
+let reset state = state.in_svg <- false; state.element_stack <- []
+
+(* SVG namespace - the DOM stores this as "svg" shorthand *)
+let svg_ns = "svg"
+
+(* Full SVG namespace URL for validation *)
+let svg_ns_url = "http://www.w3.org/2000/svg"
+
+(* Global SVG attributes allowed on all elements *)
+let global_svg_attrs = [
+  "id"; "class"; "style"; "tabindex"; "lang"; "xml:lang"; "xml:space";
+  "requiredExtensions"; "requiredFeatures"; "systemLanguage";
+  (* XLink attributes *)
+  "xlink:href"; "xlink:type"; "xlink:role"; "xlink:arcrole"; "xlink:title";
+  "xlink:show"; "xlink:actuate";
+  (* Event attributes *)
+  "onload"; "onunload"; "onabort"; "onerror"; "onresize"; "onscroll"; "onzoom";
+  "onfocusin"; "onfocusout"; "onactivate"; "onclick"; "onmousedown"; "onmouseup";
+  "onmouseover"; "onmousemove"; "onmouseout"; "onbegin"; "onend"; "onrepeat";
+  (* Presentation attributes - comprehensive list *)
+  "alignment-baseline"; "baseline-shift";
+  "clip"; "clip-path"; "clip-rule"; "color"; "color-interpolation"; "color-interpolation-filters";
+  "color-profile"; "color-rendering";
+  "cursor"; "direction"; "display"; "dominant-baseline";
+  "enable-background";
+  "fill"; "fill-opacity"; "fill-rule"; "filter";
+  "flood-color"; "flood-opacity"; "font-family"; "font-size"; "font-size-adjust";
+  "font-stretch"; "font-style"; "font-variant"; "font-weight";
+  "glyph-orientation-horizontal"; "glyph-orientation-vertical";
+  "image-rendering";
+  "kerning";
+  "letter-spacing"; "lighting-color";
+  "marker"; "marker-end"; "marker-mid"; "marker-start"; "mask";
+  "opacity"; "overflow";
+  "pointer-events";
+  "shape-rendering";
+  "stop-color"; "stop-opacity"; "stroke"; "stroke-dasharray"; "stroke-dashoffset";
+  "stroke-linecap"; "stroke-linejoin"; "stroke-miterlimit"; "stroke-opacity";
+  "stroke-width";
+  "text-anchor"; "text-decoration"; "text-rendering";
+  "transform"; "transform-origin";
+  "unicode-bidi";
+  "vector-effect"; "visibility";
+  "word-spacing"; "writing-mode";
+  (* Data attributes *)
+  "data-*";
+  (* ARIA attributes *)
+  "role"; "aria-activedescendant"; "aria-atomic"; "aria-autocomplete"; "aria-busy";
+  "aria-checked"; "aria-colcount"; "aria-colindex"; "aria-colspan"; "aria-controls";
+  "aria-current"; "aria-describedby"; "aria-details"; "aria-disabled"; "aria-dropeffect";
+  "aria-errormessage"; "aria-expanded"; "aria-flowto"; "aria-grabbed"; "aria-haspopup";
+  "aria-hidden"; "aria-invalid"; "aria-keyshortcuts"; "aria-label"; "aria-labelledby";
+  "aria-level"; "aria-live"; "aria-modal"; "aria-multiline"; "aria-multiselectable";
+  "aria-orientation"; "aria-owns"; "aria-placeholder"; "aria-posinset"; "aria-pressed";
+  "aria-readonly"; "aria-relevant"; "aria-required"; "aria-roledescription"; "aria-rowcount";
+  "aria-rowindex"; "aria-rowspan"; "aria-selected"; "aria-setsize"; "aria-sort";
+  "aria-valuemax"; "aria-valuemin"; "aria-valuenow"; "aria-valuetext";
+]
+
+(* Element-specific attributes *)
+let element_attrs = [
+  ("svg", ["xmlns"; "xmlns:xlink"; "version"; "baseProfile"; "x"; "y"; "width"; "height";
+           "viewBox"; "preserveAspectRatio"; "zoomAndPan"; "contentScriptType";
+           "contentStyleType"]);
+  ("g", ["transform"]);
+  ("defs", []);
+  ("symbol", ["viewBox"; "preserveAspectRatio"; "refX"; "refY"]);
+  ("use", ["href"; "xlink:href"; "x"; "y"; "width"; "height"]);
+  ("image", ["href"; "xlink:href"; "x"; "y"; "width"; "height"; "preserveAspectRatio";
+             "crossorigin"; "decoding"]);
+  ("switch", []);
+  ("foreignObject", ["x"; "y"; "width"; "height"]);
+
+  (* Shape elements *)
+  ("circle", ["cx"; "cy"; "r"; "pathLength"]);
+  ("ellipse", ["cx"; "cy"; "rx"; "ry"; "pathLength"]);
+  ("line", ["x1"; "y1"; "x2"; "y2"; "pathLength"]);
+  ("polygon", ["points"; "pathLength"]);
+  ("polyline", ["points"; "pathLength"]);
+  ("rect", ["x"; "y"; "width"; "height"; "rx"; "ry"; "pathLength"]);
+  ("path", ["d"; "pathLength"]);
+
+  (* Text elements *)
+  ("text", ["x"; "y"; "dx"; "dy"; "rotate"; "textLength"; "lengthAdjust"]);
+  ("tspan", ["x"; "y"; "dx"; "dy"; "rotate"; "textLength"; "lengthAdjust"]);
+  ("textPath", ["href"; "xlink:href"; "startOffset"; "method"; "spacing"; "path"; "side"]);
+
+  (* Gradient elements *)
+  ("linearGradient", ["gradientUnits"; "gradientTransform"; "spreadMethod";
+                      "href"; "xlink:href"; "x1"; "y1"; "x2"; "y2"]);
+  ("radialGradient", ["gradientUnits"; "gradientTransform"; "spreadMethod";
+                      "href"; "xlink:href"; "cx"; "cy"; "r"; "fx"; "fy"; "fr"]);
+  ("stop", ["offset"]);
+
+  (* Pattern *)
+  ("pattern", ["patternUnits"; "patternContentUnits"; "patternTransform";
+               "href"; "xlink:href"; "x"; "y"; "width"; "height"; "viewBox";
+               "preserveAspectRatio"]);
+
+  (* Clipping and masking *)
+  ("clipPath", ["clipPathUnits"]);
+  ("mask", ["maskUnits"; "maskContentUnits"; "x"; "y"; "width"; "height"]);
+
+  (* Filter elements *)
+  ("filter", ["filterUnits"; "primitiveUnits"; "x"; "y"; "width"; "height";
+              "href"; "xlink:href"]);
+  ("feBlend", ["in"; "in2"; "mode"; "x"; "y"; "width"; "height"; "result"]);
+  ("feColorMatrix", ["in"; "type"; "values"; "x"; "y"; "width"; "height"; "result"]);
+  ("feComponentTransfer", ["in"; "x"; "y"; "width"; "height"; "result"]);
+  ("feFuncR", ["type"; "tableValues"; "slope"; "intercept"; "amplitude"; "exponent"; "offset"]);
+  ("feFuncG", ["type"; "tableValues"; "slope"; "intercept"; "amplitude"; "exponent"; "offset"]);
+  ("feFuncB", ["type"; "tableValues"; "slope"; "intercept"; "amplitude"; "exponent"; "offset"]);
+  ("feFuncA", ["type"; "tableValues"; "slope"; "intercept"; "amplitude"; "exponent"; "offset"]);
+  ("feComposite", ["in"; "in2"; "operator"; "k1"; "k2"; "k3"; "k4"; "x"; "y"; "width"; "height"; "result"]);
+  ("feConvolveMatrix", ["in"; "order"; "kernelMatrix"; "divisor"; "bias"; "targetX"; "targetY";
+                        "edgeMode"; "preserveAlpha"; "x"; "y"; "width"; "height"; "result"]);
+  ("feDiffuseLighting", ["in"; "surfaceScale"; "diffuseConstant"; "x"; "y"; "width"; "height"; "result"]);
+  ("feDisplacementMap", ["in"; "in2"; "scale"; "xChannelSelector"; "yChannelSelector";
+                         "x"; "y"; "width"; "height"; "result"]);
+  ("feDropShadow", ["in"; "dx"; "dy"; "stdDeviation"; "x"; "y"; "width"; "height"; "result"]);
+  ("feFlood", ["x"; "y"; "width"; "height"; "result"]);
+  ("feGaussianBlur", ["in"; "stdDeviation"; "edgeMode"; "x"; "y"; "width"; "height"; "result"]);
+  ("feImage", ["href"; "xlink:href"; "preserveAspectRatio"; "crossorigin";
+               "x"; "y"; "width"; "height"; "result"]);
+  ("feMerge", ["x"; "y"; "width"; "height"; "result"]);
+  ("feMergeNode", ["in"]);
+  ("feMorphology", ["in"; "operator"; "radius"; "x"; "y"; "width"; "height"; "result"]);
+  ("feOffset", ["in"; "dx"; "dy"; "x"; "y"; "width"; "height"; "result"]);
+  ("fePointLight", ["x"; "y"; "z"]);
+  ("feSpecularLighting", ["in"; "surfaceScale"; "specularConstant"; "specularExponent";
+                          "x"; "y"; "width"; "height"; "result"]);
+  ("feSpotLight", ["x"; "y"; "z"; "pointsAtX"; "pointsAtY"; "pointsAtZ";
+                   "specularExponent"; "limitingConeAngle"]);
+  ("feTile", ["in"; "x"; "y"; "width"; "height"; "result"]);
+  ("feTurbulence", ["type"; "baseFrequency"; "numOctaves"; "seed"; "stitchTiles";
+                    "x"; "y"; "width"; "height"; "result"]);
+
+  (* Marker *)
+  ("marker", ["viewBox"; "preserveAspectRatio"; "refX"; "refY"; "markerUnits";
+              "markerWidth"; "markerHeight"; "orient"]);
+
+  (* Descriptive elements *)
+  ("title", []);
+  ("desc", []);
+  ("metadata", []);
+
+  (* Animation elements *)
+  ("animate", ["attributeName"; "attributeType"; "from"; "to"; "by"; "values";
+               "begin"; "dur"; "end"; "min"; "max"; "restart"; "repeatCount";
+               "repeatDur"; "fill"; "calcMode"; "keyTimes"; "keySplines";
+               "additive"; "accumulate"; "href"; "xlink:href"]);
+  ("animateMotion", ["path"; "keyPoints"; "rotate"; "origin";
+                     "begin"; "dur"; "end"; "min"; "max"; "restart"; "repeatCount";
+                     "repeatDur"; "fill"; "calcMode"; "keyTimes"; "keySplines";
+                     "additive"; "accumulate"; "href"; "xlink:href"]);
+  ("animateTransform", ["attributeName"; "attributeType"; "type"; "from"; "to"; "by"; "values";
+                        "begin"; "dur"; "end"; "min"; "max"; "restart"; "repeatCount";
+                        "repeatDur"; "fill"; "calcMode"; "keyTimes"; "keySplines";
+                        "additive"; "accumulate"; "href"; "xlink:href"]);
+  ("set", ["attributeName"; "attributeType"; "to";
+           "begin"; "dur"; "end"; "min"; "max"; "restart"; "repeatCount";
+           "repeatDur"; "fill"; "href"; "xlink:href"]);
+  ("mpath", ["href"; "xlink:href"]);
+
+  (* Font elements (deprecated but still valid SVG 1.1) *)
+  ("font", ["horiz-origin-x"; "horiz-origin-y"; "horiz-adv-x"; "vert-origin-x";
+            "vert-origin-y"; "vert-adv-y"]);
+  ("font-face", ["font-family"; "font-style"; "font-variant"; "font-weight";
+                 "font-stretch"; "font-size"; "unicode-range"; "units-per-em";
+                 "panose-1"; "stemv"; "stemh"; "slope"; "cap-height"; "x-height";
+                 "accent-height"; "ascent"; "descent"; "widths"; "bbox";
+                 "ideographic"; "alphabetic"; "mathematical"; "hanging";
+                 "v-ideographic"; "v-alphabetic"; "v-mathematical"; "v-hanging";
+                 "underline-position"; "underline-thickness"; "strikethrough-position";
+                 "strikethrough-thickness"; "overline-position"; "overline-thickness"]);
+  ("font-face-src", []);
+  ("font-face-uri", ["href"; "xlink:href"]);
+  ("font-face-format", ["string"]);
+  ("font-face-name", ["name"]);
+  ("glyph", ["unicode"; "glyph-name"; "d"; "orientation"; "arabic-form"; "lang";
+             "horiz-adv-x"; "vert-origin-x"; "vert-origin-y"; "vert-adv-y"]);
+  ("missing-glyph", ["d"; "horiz-adv-x"; "vert-origin-x"; "vert-origin-y"; "vert-adv-y"]);
+  ("hkern", ["u1"; "g1"; "u2"; "g2"; "k"]);
+  ("vkern", ["u1"; "g1"; "u2"; "g2"; "k"]);
+
+  (* Link *)
+  ("a", ["href"; "xlink:href"; "target"; "download"; "ping"; "rel"; "hreflang"; "type";
+         "referrerpolicy"]);
+
+  (* Script and style *)
+  ("script", ["href"; "xlink:href"; "type"; "crossorigin"]);
+  ("style", ["type"; "media"; "title"]);
+
+  (* View *)
+  ("view", ["viewBox"; "preserveAspectRatio"; "zoomAndPan"; "viewTarget"]);
+]
+
+(* Required attributes for certain elements *)
+let required_attrs = [
+  ("feConvolveMatrix", ["order"]);
+  ("rect", ["width"; "height"]);
+  ("font", ["horiz-adv-x"]);
+]
+
+(* Attributes that are NOT allowed on specific elements - overrides global/element attrs *)
+(* NOTE: Element names must be lowercase for lookup to work *)
+let disallowed_attrs = [
+  (* fill/stroke not valid on image *)
+  ("image", ["fill"; "fill-opacity"; "fill-rule"]);
+  (* stop-color/stop-opacity only valid on stop element and containers for inheritance *)
+  ("rect", ["stop-color"; "stop-opacity"]);
+  (* marker shorthand not valid on container elements *)
+  ("g", ["marker"]);
+  ("svg", ["marker"; "contentScriptType"; "contentStyleType"]);
+  (* x,y not valid on clipPath *)
+  ("clippath", ["x"; "y"; "width"; "height"]);
+]
+
+(* Required child elements - for future use *)
+let _required_children = [
+  ("font", ["missing-glyph"]);
+]
+
+(* Check if attribute name matches a pattern like "data-*" or "aria-*" - case insensitive *)
+let matches_pattern attr pattern =
+  let attr_lower = String.lowercase_ascii attr in
+  let pattern_lower = String.lowercase_ascii pattern in
+  if String.ends_with ~suffix:"-*" pattern_lower then
+    let prefix = String.sub pattern_lower 0 (String.length pattern_lower - 1) in
+    String.starts_with ~prefix attr_lower
+  else
+    attr_lower = pattern_lower
+
+(* Check if attribute is valid for element *)
+let is_valid_attr element attr =
+  (* First check if this attribute is specifically disallowed on this element *)
+  (match List.assoc_opt element disallowed_attrs with
+  | Some disallowed ->
+      if List.exists (matches_pattern attr) disallowed then false
+      else true
+  | None -> true) &&
+  (* Then check global attrs *)
+  (if List.exists (matches_pattern attr) global_svg_attrs then true
+  else
+    (* Check element-specific attrs *)
+    match List.assoc_opt element element_attrs with
+    | Some attrs -> List.exists (matches_pattern attr) attrs
+    | None ->
+        (* Unknown SVG element - be permissive *)
+        true)
+
+(* Validate xmlns attributes *)
+let validate_xmlns_attr attr value element collector =
+  match attr with
+  | "xmlns" when element = "svg" ->
+      if value <> svg_ns_url then
+        Message_collector.add_error collector
+          ~message:(Printf.sprintf
+            "Bad value \xe2\x80\x9c%s\xe2\x80\x9d for the attribute \xe2\x80\x9cxmlns\xe2\x80\x9d (only \xe2\x80\x9c%s\xe2\x80\x9d permitted here)."
+            value svg_ns_url)
+          ~element
+          ~attribute:attr
+          ()
+  | "xmlns:xlink" ->
+      if value <> "http://www.w3.org/1999/xlink" then
+        Message_collector.add_error collector
+          ~message:(Printf.sprintf
+            "Bad value \xe2\x80\x9c%s\xe2\x80\x9d for the attribute \xe2\x80\x9cxmlns:xlink\xe2\x80\x9d (only \xe2\x80\x9chttp://www.w3.org/1999/xlink\xe2\x80\x9d permitted here)."
+            value)
+          ~element
+          ~attribute:attr
+          ()
+  | _ when String.starts_with ~prefix:"xmlns:" attr && attr <> "xmlns:xlink" ->
+      (* Other xmlns declarations are not allowed in HTML-embedded SVG *)
+      Message_collector.add_error collector
+        ~message:(Printf.sprintf "Attribute \xe2\x80\x9c%s\xe2\x80\x9d not allowed here." attr)
+        ~element
+        ~attribute:attr
+        ()
+  | _ -> ()
+
+(* Validate SVG path data *)
+let validate_path_data d element collector =
+  (* Simple path data validation - check for obviously invalid characters *)
+  let len = String.length d in
+  let i = ref 0 in
+  let context_start = ref 0 in
+  while !i < len do
+    let c = d.[!i] in
+    match c with
+    | 'M' | 'm' | 'L' | 'l' | 'H' | 'h' | 'V' | 'v' | 'C' | 'c' | 'S' | 's'
+    | 'Q' | 'q' | 'T' | 't' | 'A' | 'a' | 'Z' | 'z'
+    | '0'..'9' | '.' | '-' | '+' | ',' | ' ' | '\t' | '\n' | '\r' | 'e' | 'E' ->
+        incr i
+    | '#' ->
+        let ctx_end = min (String.length d) (!i + 1) in
+        let context = String.sub d !context_start (ctx_end - !context_start) in
+        Message_collector.add_error collector
+          ~message:(Printf.sprintf
+            "Bad value \xe2\x80\x9c%s\xe2\x80\x9d for attribute \xe2\x80\x9cd\xe2\x80\x9d on element \xe2\x80\x9c%s\xe2\x80\x9d: Bad SVG path data: Expected command but found \xe2\x80\x9c#\xe2\x80\x9d (context: \xe2\x80\x9c%s\xe2\x80\x9d)."
+            d element context)
+          ~element
+          ~attribute:"d"
+          ();
+        i := len (* Stop processing *)
+    | _ ->
+        incr i
+  done;
+  (* Check arc command flags - they must be 0 or 1 *)
+  (* This is a simplified check - look for 'a' or 'A' followed by numbers *)
+  let arc_re = Str.regexp "[aA][ \t\n]*\\([0-9.+-]+\\)[ \t\n,]*\\([0-9.+-]+\\)[ \t\n,]*\\([0-9.+-]+\\)[ \t\n,]*\\([0-9]+\\)" in
+  try
+    let _ = Str.search_forward arc_re d 0 in
+    let flag = Str.matched_group 4 d in
+    if flag <> "0" && flag <> "1" then begin
+      let pos = Str.match_beginning () in
+      let ctx_end = min (String.length d) (pos + 25) in
+      let ctx_start = max 0 (pos - 10) in
+      let context = String.sub d ctx_start (ctx_end - ctx_start) in
+      Message_collector.add_error collector
+        ~message:(Printf.sprintf
+          "Bad value \xe2\x80\x9c%s\xe2\x80\x9d for attribute \xe2\x80\x9cd\xe2\x80\x9d on element \xe2\x80\x9c%s\xe2\x80\x9d: Bad SVG path data: Expected \xe2\x80\x9c0\xe2\x80\x9d or \xe2\x80\x9c1\xe2\x80\x9d for large-arc-flag for \xe2\x80\x9ca\xe2\x80\x9d command but found \xe2\x80\x9c%s\xe2\x80\x9d instead (context: \xe2\x80\x9c%s\xe2\x80\x9d)."
+          d element flag context)
+        ~element
+        ~attribute:"d"
+        ()
+    end
+  with Not_found -> ()
+
+let start_element state ~name ~namespace ~attrs collector =
+  let is_svg_element = namespace = Some svg_ns in
+
+  (* Track if we're in SVG context *)
+  if name = "svg" && is_svg_element then
+    state.in_svg <- true;
+
+  if is_svg_element || state.in_svg then begin
+    state.element_stack <- name :: state.element_stack;
+
+    let name_lower = String.lowercase_ascii name in
+
+    (* Check each attribute *)
+    List.iter (fun (attr, value) ->
+      let attr_lower = String.lowercase_ascii attr in
+
+      (* Validate xmlns attributes *)
+      if String.starts_with ~prefix:"xmlns" attr_lower then
+        validate_xmlns_attr attr_lower value name_lower collector
+      (* Check xml:* attributes - most are not allowed *)
+      else if attr_lower = "xml:id" || attr_lower = "xml:base" then
+        Message_collector.add_error collector
+          ~message:(Printf.sprintf
+            "Attribute \xe2\x80\x9c%s\xe2\x80\x9d not allowed on element \xe2\x80\x9c%s\xe2\x80\x9d at this point."
+            attr name_lower)
+          ~element:name_lower
+          ~attribute:attr_lower
+          ()
+      (* Validate path data *)
+      else if attr_lower = "d" && name_lower = "path" then
+        validate_path_data value name_lower collector
+      (* Check if attribute is valid for this element *)
+      else if not (is_valid_attr name_lower attr_lower) then
+        Message_collector.add_error collector
+          ~message:(Printf.sprintf
+            "Attribute \xe2\x80\x9c%s\xe2\x80\x9d not allowed on element \xe2\x80\x9c%s\xe2\x80\x9d at this point."
+            attr name_lower)
+          ~element:name_lower
+          ~attribute:attr_lower
+          ()
+    ) attrs;
+
+    (* Check required attributes *)
+    (match List.assoc_opt name_lower required_attrs with
+    | Some req_attrs ->
+        List.iter (fun req_attr ->
+          if not (List.exists (fun (a, _) -> String.lowercase_ascii a = req_attr) attrs) then
+            Message_collector.add_error collector
+              ~message:(Printf.sprintf
+                "Element \xe2\x80\x9c%s\xe2\x80\x9d is missing required attribute \xe2\x80\x9c%s\xe2\x80\x9d."
+                name_lower req_attr)
+              ~element:name_lower
+              ()
+        ) req_attrs
+    | None -> ())
+  end
+
+let end_element state ~name ~namespace _collector =
+  let is_svg_element = namespace = Some svg_ns in
+
+  if is_svg_element || state.in_svg then begin
+    (* Pop from stack *)
+    (match state.element_stack with
+    | _ :: rest -> state.element_stack <- rest
+    | [] -> ());
+
+    (* Exit SVG context *)
+    if name = "svg" && is_svg_element then
+      state.in_svg <- false
+  end
+
+let characters _state _text _collector = ()
+
+let end_document _state _collector = ()
+
+let checker =
+  (module struct
+    type nonrec state = state
+    let create = create
+    let reset = reset
+    let start_element = start_element
+    let end_element = end_element
+    let characters = characters
+    let end_document = end_document
+  end : Checker.S)

lib/html5_checker/specialized/svg_checker.mli

···
+(** SVG attribute and element validation checker.
+
+    Validates SVG elements and attributes according to SVG 1.1/2 specifications. *)
+
+val checker : Checker.t

test/debug_check.ml

···
 let () =
-  let test_file = "validator/tests/xhtml/elements/menu/menu-containing-hr-novalid.xhtml" in
+  let test_file = "validator/tests/xhtml/elements/progress/002-isvalid.xhtml" in
   let ic = open_in test_file in
   let html = really_input_string ic (in_channel_length ic) in
   close_in ic;
   let reader = Bytesrw.Bytes.Reader.of_string html in
   let doc = Html5rw.parse ~collect_errors:true reader in
   let root = Html5rw.root doc in
-  print_endline "=== DOM Structure ===";
+  print_endline "=== DOM Structure (with namespaces) ===";
   let rec print_node indent (node : Html5rw.Dom.node) =
     let open Html5rw.Dom in
     match node.name with
-    | "#text" ->
-        let text = String.trim node.data in
-        if String.length text > 0 then
-          Printf.printf "%sTEXT: %s\n" indent text
+    | "#text" -> ()
     | "#document" | "#document-fragment" ->
         Printf.printf "%s%s\n" indent node.name;
         List.iter (print_node (indent ^ "  ")) node.children
-    | "!doctype" -> Printf.printf "%s<!DOCTYPE>\n" indent
+    | "!doctype" -> ()
     | "#comment" -> ()
     | _ ->
-        Printf.printf "%s<%s>\n" indent node.name;
+        let ns = match node.namespace with Some ns -> ns | None -> "none" in
+        Printf.printf "%s<%s ns=%s>\n" indent node.name ns;
+        List.iter (fun (k, v) ->
+          if k = "foo" then Printf.printf "%s  @%s=%s\n" indent k v
+        ) node.attrs;
         List.iter (print_node (indent ^ "  ")) node.children
   in
   print_node "" root;
-  print_endline "\n=== Now checking ===";
+  print_endline "\n=== Checking... ===";
   let reader2 = Bytesrw.Bytes.Reader.of_string html in
   let result = Html5_checker.check ~collect_parse_errors:true ~system_id:test_file reader2 in
   let errors = Html5_checker.errors result in
-  let warnings = Html5_checker.warnings result in
   print_endline "=== Errors ===";
   List.iter (fun e -> print_endline e.Html5_checker.Message.message) errors;
-  print_endline "=== Warnings ===";
-  List.iter (fun e -> print_endline e.Html5_checker.Message.message) warnings;
   print_endline "\n=== Expected ===";
-  print_endline "Element \xe2\x80\x9chr\xe2\x80\x9d not allowed as child of element \xe2\x80\x9cmenu\xe2\x80\x9d in this context. (Suppressing further errors from this subtree.)";
-  if List.length errors > 0 then
-    print_endline "\nPASS (has errors)"
-  else
-    print_endline "\nFAIL (no errors)"
+  print_endline "Element \xe2\x80\x9crect\xe2\x80\x9d is missing required attribute \xe2\x80\x9cheight\xe2\x80\x9d."