From acb4fcdc367aa59a44b3a0e20f84bc24b4f63b98 Mon Sep 17 00:00:00 2001
From: John Whitington <john@coherentgraphics.co.uk>
Date: Mon, 24 Jun 2024 16:33:43 +0100
Subject: [PATCH] Allow just a single test to be run

---
 cpdfcommand.ml | 15 ++++++++++-----
 cpdfua.ml      | 23 +++++++++++++++--------
 cpdfua.mli     |  4 ++--
 3 files changed, 27 insertions(+), 15 deletions(-)

diff --git a/cpdfcommand.ml b/cpdfcommand.ml
index 3d9733a..53cd1ed 100644
--- a/cpdfcommand.ml
+++ b/cpdfcommand.ml
@@ -536,7 +536,8 @@ type args =
    mutable resample_factor : float;
    mutable resample_interpolate : bool;
    mutable jbig2_lossy_threshold : float;
-   mutable extract_stream_decompress : bool}
+   mutable extract_stream_decompress : bool;
+   mutable verify_single : string option}
 
 let args =
   {op = None;
@@ -670,7 +671,8 @@ let args =
    resample_factor = 101.;
    resample_interpolate = false;
    jbig2_lossy_threshold = 0.85;
-   extract_stream_decompress = false}
+   extract_stream_decompress = false;
+   verify_single = None}
 
 (* Do not reset original_filename or cpdflin or was_encrypted or
 was_decrypted_with_owner or recrypt or producer or creator or path_to_* or
@@ -792,7 +794,8 @@ let reset_arguments () =
   args.resample_interpolate <- false;
   args.jbig2_lossy_threshold <- 0.85;
   args.extract_stream_decompress <- false;
-  clear Cpdfdrawcontrol.fontpack_initialised
+  clear Cpdfdrawcontrol.fontpack_initialised;
+  args.verify_single <- None
 
 (* Prefer a) the one given with -cpdflin b) a local cpdflin, c) otherwise assume
 installed at a system place *)
@@ -2819,6 +2822,7 @@ and specs =
    ("-obj", Arg.String setprintobj, "Print object");
    ("-json", Arg.Unit (fun () -> args.format_json <- true), "Format output as JSON");
    ("-verify", Arg.String (fun s -> setop (Verify s) ()), "Verify conformance to a standard");
+   ("-verify-single", Arg.String (fun s -> args.verify_single <- Some s), "Verify a single test");
    ("-mark-as", Arg.String (fun s -> setop (MarkAs s) ()), "Mark as conforming to a standard");
    ("-remove-mark", Arg.String (fun s -> setop (RemoveMark s) ()), "Remove conformance mark");
    ("-extract-struct-tree", Arg.Unit (fun () -> setop ExtractStructTree ()), "Extract structure tree in JSON format");
@@ -4486,9 +4490,10 @@ let go () =
       begin match standard with
       | "PDF/UA-1(matterhorn)" ->
           let pdf = get_single_pdf args.op false in
+          let testname = match args.verify_single with None -> "" | Some x -> x in
             if args.format_json
-              then flprint (Cpdfyojson.Safe.pretty_to_string (Cpdfua.test_matterhorn_json pdf))
-              else Cpdfua.test_matterhorn_print pdf
+              then flprint (Cpdfyojson.Safe.pretty_to_string (Cpdfua.test_matterhorn_json pdf testname))
+              else Cpdfua.test_matterhorn_print pdf testname
       | _ -> error "Unknown verification type."
       end
   | Some (MarkAs standard) ->
diff --git a/cpdfua.ml b/cpdfua.ml
index e448770..015b66f 100644
--- a/cpdfua.ml
+++ b/cpdfua.ml
@@ -1302,9 +1302,16 @@ let matterhorn =
    ("31-030", "One or more characters used in text showing operators reference the .notdef glyph.", "UA1:7.21.8-1", matterhorn_31_030);
   ]
 
-(* FIXME Allow the use of just a single test, and expose it in cpdf command line *)
-
-let test_matterhorn pdf =
+let test_matterhorn pdf testname =
+  let tests =
+    match testname with
+    | "" -> matterhorn
+    | n -> 
+        match keep (fun (n', _, _, _) -> n' = n) matterhorn with
+        | [] -> error "test not found"
+        | [t] -> [t]
+        | _ -> error "duplicate test"
+  in
   (* A circularity in the role map prevents all structure checks, so we do it first at stop if it fails. *)
   let circularity_error =
     try matterhorn_02_003 0 0 pdf; [] with
@@ -1320,21 +1327,21 @@ let test_matterhorn pdf =
            | MatterhornError extra -> Some (name, error, section, extra)
            | MatterhornUnimplemented -> None
            | e -> Some (name, "Incomplete", section, `String ("ERROR: " ^ Printexc.to_string e)))
-        matterhorn
+        tests
 
-let test_matterhorn_print pdf =
+let test_matterhorn_print pdf testname =
   iter
     (fun (name, error, section, extra) ->
        Printf.eprintf "%s %s %s %s\n" name section error
        (if extra = `Null then "" else "(" ^ Cpdfyojson.Safe.to_string extra ^ ")"))
-    (test_matterhorn pdf)
+    (test_matterhorn pdf testname)
 
-let test_matterhorn_json pdf =
+let test_matterhorn_json pdf testname =
   `List
     (map
       (fun (name, error, section, extra) ->
         `Assoc [("name", `String name); ("section", `String section); ("error", `String error); ("extra", extra)])
-      (test_matterhorn pdf))
+      (test_matterhorn pdf testname))
 
 let pdfua_marker =
   Cpdfmetadata.(E (((rdf, "Description"), [((rdf, "about"), ""); ((Cpdfxmlm.ns_xmlns, "pdfuaid"), pdfuaid)]), [E (((pdfuaid, "part"), []), [D "1"])])) 
diff --git a/cpdfua.mli b/cpdfua.mli
index a9dd682..ca9ddab 100644
--- a/cpdfua.mli
+++ b/cpdfua.mli
@@ -1,7 +1,7 @@
 (** PDF/UA *)
-val test_matterhorn_print : Pdf.t -> unit
+val test_matterhorn_print : Pdf.t -> string -> unit
 
-val test_matterhorn_json : Pdf.t -> Cpdfyojson.Safe.t
+val test_matterhorn_json : Pdf.t -> string -> Cpdfyojson.Safe.t
 
 val mark : Pdf.t -> unit