Resolve brittle output

.vscode/settings.json

@@ -1,19 +1,33 @@
 {
+    "files.insertFinalNewline": true,
+    "files.trimFinalNewlines": true,
     "cSpell.words": [
         "abstr",
         "alli",
+        "Barbin",
         "conv",
         "dedup",
         "Doublable",
+        "endline",
         "functors",
         "GADT",
         "injective",
         "injectivity",
         "janestreet",
         "kinded",
+        "Mathieu",
+        "mdexp",
+        "noprompt",
         "odoc",
         "opam",
         "repr",
-        "uids"
+        "Sexp",
+        "Sexplib",
+        "Stdlib",
+        "toplevel",
+        "uids",
+        "WEXITED",
+        "WSIGNALED",
+        "WSTOPPED"
     ]
-}
+}

doc/docs/explanation/lookup-strategy/README.md

@@ -132,7 +132,7 @@ to n) is kept sorted by trait and is searched using a binary search.
 ```ocaml
 let binary_search_with_cache : lookup_strategy =
   fun provider trait ->
-  if Array.length provider = 0
+  if Int.equal 0 (Array.length provider)
   then None [@coverage off]
   else (
     let cache = provider.(0) in

doc/docs/explanation/lookup-strategy/lookup_strategy.ml

@@ -151,7 +151,7 @@ let%expect_test "binary_search" =
 
 let binary_search_with_cache : lookup_strategy =
   fun provider trait ->
-  if Array.length provider = 0
+  if Int.equal 0 (Array.length provider)
   then None [@coverage off]
   else (
     let cache = provider.(0) in

doc/docs/tutorials/provider-explicit/README.md

@@ -345,7 +345,7 @@ let map_n_times
   fun provider t n ~f ->
   let module M = (val Provider.lookup provider ~trait:Mappable.t) in
   let at = M.project t in
-  let rec loop n at = if n = 0 then at else loop (n - 1) (M.map at ~f) in
+  let rec loop n at = if Int.equal n 0 then at else loop (n - 1) (M.map at ~f) in
   M.inject (loop n at)
 ;;
 ```

doc/docs/tutorials/provider-explicit/provider_explicit.ml

@@ -21,8 +21,7 @@ module Ocaml_toplevel = Provider_toplevel_test.Ocaml_toplevel
 
 let%expect_test "module-dependent function" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 module type Id = sig
   type t
 
@@ -381,8 +380,7 @@ type mappable = [ `Mappable ]
 
 let%expect_test "higher-order hallucination" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 module Mappable : sig
   val t : ('a 't, (module Mappable with type 'a t = 'a 't), [> mappable ]) Provider.Trait.t
 end = Provider.Trait.Create (struct
@@ -448,7 +446,7 @@ let map_n_times
   fun provider t n ~f ->
   let module M = (val Provider.lookup provider ~trait:Mappable.t) in
   let at = M.project t in
-  let rec loop n at = if n = 0 then at else loop (n - 1) (M.map at ~f) in
+  let rec loop n at = if Int.equal n 0 then at else loop (n - 1) (M.map at ~f) in
   M.inject (loop n at)
 ;;
 

dune-project

@@ -91,7 +91,5 @@
    (= :version))
   (provider-tests
    (= :version))
-  (re
-   (>= 1.12.0))
   (sherlodoc
    (>= 0.2))))

provider-dev.opam

@@ -19,7 +19,6 @@ depends: [
   "ppxlib" {>= "0.33"}
   "provider" {= version}
   "provider-tests" {= version}
-  "re" {>= "1.12.0"}
   "sherlodoc" {>= "0.2"}
   "odoc" {with-doc}
 ]

src/provider.ml

@@ -94,7 +94,12 @@ let dedup_sorted_keep_last =
     | [] -> []
     | [ elt ] -> [ elt ]
     | elt1 :: (elt2 :: _ as tl) ->
-      if compare elt1 elt2 = 0 then aux tl ~compare else elt1 :: aux tl ~compare
+      if compare elt1 elt2 = 0
+      then aux tl ~compare
+      else
+        (* Coverage is off in the second part of the expression because the
+           instrumentation breaks [@tail_mod_cons], triggering warning 71. *)
+        elt1 :: (aux tl ~compare [@coverage off])
   in
   aux
 ;;

src/stdlib/stdlib0.ml

@@ -24,6 +24,7 @@ module Sexp = Sexplib0.Sexp
 module String = String0
 module With_equal_and_dyn = With_equal_and_dyn0
 
+let ( = ) = `Use_Poly_when_needed
 let phys_equal = Stdlib.( == )
 let print pp = Format.printf "%a@." Pp.to_fmt pp
 let print_dyn dyn = print (Dyn.pp dyn)

src/stdlib/stdlib0.mli

@@ -27,6 +27,7 @@ module With_equal_and_dyn = With_equal_and_dyn0
 val phys_equal : 'a -> 'a -> bool
 val print_dyn : Dyn.t -> unit
 val print_s : Sexp.t -> unit
+val ( = ) : [ `Use_Poly_when_needed ]
 
 (** Expect test helpers. *)
 

test/test__higher_kinded.ml

@@ -52,7 +52,7 @@ let map_n_times
   fun provider t n ~f ->
   let module M = (val Provider.lookup provider ~trait:Mappable.t) in
   let at = M.project t in
-  let rec loop n at = if n = 0 then at else loop (n - 1) (M.map at ~f) in
+  let rec loop n at = if Int.equal n 0 then at else loop (n - 1) (M.map at ~f) in
   M.inject (loop n at)
 ;;
 

test/test__import.ml

@@ -8,10 +8,10 @@ module Import = Provider.Private.Import
 
 let%expect_test "Array.for_alli" =
   let t = Array.init 10 ~f:Fn.id in
-  require (Import.Array.for_alli t ~f:(fun i x -> i = x));
+  require (Import.Array.for_alli t ~f:Int.equal);
   [%expect {||}];
   t.(9) <- 0;
-  require (not (Import.Array.for_alli t ~f:(fun i x -> i = x)));
+  require (not (Import.Array.for_alli t ~f:Int.equal));
   [%expect {||}];
   ()
 ;;

test/test__trait0.ml

@@ -92,8 +92,8 @@ let%expect_test "Marshal extensible variant" =
   require (not (phys_equal A (B 0)));
   require (not (phys_equal (B 0) (B 0)));
   let id (t : t) = Obj.Extension_constructor.id (Obj.Extension_constructor.of_val t) in
-  require (id (B 0) = id (B 0));
-  require (id (B 0) = id (B 2));
+  require (Int.equal (id (B 0)) (id (B 0)));
+  require (Int.equal (id (B 0)) (id (B 2)));
   (* Marshalling does not preserve physical equality of extensible variant with
      no arguments. *)
   let marshal = Marshal.to_string A [] in

test/toplevel/dune

@@ -15,7 +15,7 @@
   +a
   -open
   Stdlib_for_test)
- (libraries provider re stdlib_for_test unix)
+ (libraries provider stdlib_for_test unix)
  (instrumentation
   (backend bisect_ppx))
  (lint

test/toplevel/ocaml_toplevel.ml

@@ -8,23 +8,34 @@ module Unix = UnixLabels
 
 let toplevel_exe = "./provider_toplevel.exe"
 
-let file_path_re =
-  lazy
-    (Re.compile
-       (Re.seq
-          [ Re.str {|File "|}
-          ; Re.group (Re.rep1 (Re.compl [ Re.char '"' ]))
-          ; Re.str {|"|}
-          ]))
+let string_is_substring s ~substring =
+  let len_s = String.length s in
+  let len_sub = String.length substring in
+  let rec aux i =
+    if i + len_sub > len_s
+    then false
+    else if String.equal (String.sub s ~pos:i ~len:len_sub) substring
+    then true
+    else aux (i + 1)
+  in
+  aux 0
 ;;
 
-let use_basename_in_file_paths s =
-  Re.replace (Lazy.force file_path_re) s ~f:(fun group ->
-    let path = Re.Group.get group 1 in
-    Printf.sprintf {|File "%s"|} (Filename.basename path))
+let truncate_after_line lines ~delimiter =
+  let[@tail_mod_cons] rec aux = function
+    | [] -> ([] [@coverage off])
+    | line :: rest ->
+      if string_is_substring line ~substring:delimiter
+      then [ line ]
+      else
+        (* Coverage is off in the second part of the expression because the
+           instrumentation breaks [@tail_mod_cons], triggering warning 71. *)
+        line :: (aux rest [@coverage off])
+  in
+  aux lines
 ;;
 
-let eval ~code =
+let eval ?truncate_after code =
   let code = String.trim code in
   print_endline "```ocaml";
   print_endline code;
@@ -39,9 +50,16 @@ let eval ~code =
   let stdout_content = In_channel.input_all ic in
   let stderr_content = In_channel.input_all ec in
   let status = Unix.close_process_full (ic, oc, ec) in
-  let stdout_trimmed = String.trim stdout_content |> use_basename_in_file_paths in
+  let stdout_trimmed =
+    String.trim stdout_content
+    |> String.split_lines
+    |> (match truncate_after with
+      | None -> Fun.id
+      | Some delimiter -> truncate_after_line ~delimiter)
+    |> String.concat ~sep:"\n"
+  in
   if String.length stdout_trimmed > 0 then print_endline stdout_trimmed;
-  let stderr_trimmed = String.trim stderr_content |> use_basename_in_file_paths in
+  let stderr_trimmed = String.trim stderr_content in
   if String.length stderr_trimmed > 0 then print_endline stderr_trimmed [@coverage off];
   (match status with
    | WEXITED 0 -> ()

test/toplevel/ocaml_toplevel.mli

@@ -4,4 +4,4 @@
 (*_  SPDX-License-Identifier: ISC                                                 *)
 (*_********************************************************************************)
 
-val eval : code:string -> unit
+val eval : ?truncate_after:string -> string -> unit

test/toplevel/test__magic.ml

@@ -19,8 +19,7 @@
 
 let%expect_test "trait extension attempt" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 module type S = sig
   type t
 

test/toplevel/test__magic2.ml

@@ -16,8 +16,7 @@
 
 let%expect_test "trait extension attempt" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 module type S = sig
   type t
 

test/toplevel/test__magic3.md

@@ -48,7 +48,6 @@ end)
      is not included in
        type (!'a, 'b) t
      Their variances do not agree.
-     File "provider.mli", line 82, characters 6-22: Expected declaration
 ```
 
 Trying to force the injectivity won't do either.

test/toplevel/test__magic3.ml

@@ -13,8 +13,7 @@
 
 let%expect_test "direct trait extension" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 type ('a, 'impl, 'tag) Provider.Trait.t += Trait : (unit, 'a, [ `A ]) Provider.Trait.t
 ;;
 |};
@@ -50,8 +49,8 @@ type ('a, 'impl, 'tag) Provider.Trait.t += Trait : (unit, 'a, [ `A ]) Provider.T
 
 let%expect_test "create1 unit type" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    ~truncate_after:"Their variances do not agree."
+    {|
 module Trait = Provider.Trait.Create1 (struct
   type (_, _) t = unit
   type 'a module_type = 'a
@@ -83,7 +82,6 @@ end)
          is not included in
            type (!'a, 'b) t
          Their variances do not agree.
-         File "provider.mli", line 82, characters 6-22: Expected declaration
     ```
     |}]
 ;;
@@ -94,8 +92,7 @@ end)
 
 let%expect_test "create1 forced injectivity" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 module Trait = Provider.Trait.Create1 (struct
   type (!'a, _) t = unit
   type 'a module_type = 'a
@@ -133,8 +130,7 @@ end)
 
 let%expect_test "create1 record type" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 type record = { a : string }
 
 module Trait = Provider.Trait.Create1 (struct
@@ -169,8 +165,7 @@ end)
 
 let%expect_test "create1 variant type" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 type variant = A
 
 module Trait = Provider.Trait.Create1 (struct
@@ -236,8 +231,7 @@ let _c = (Trait.t : (int, int, [ `A ]) Provider.Trait.t)
 
 let%expect_test "trait coercion failure" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 module Trait = Provider.Trait.Create1 (struct
   type (!'a, _) t = 'a
   type 'a module_type = 'a
@@ -286,8 +280,7 @@ let _b = (Trait.t : (int, int, [ `A ]) Provider.Trait.t)
 
 let%expect_test "lookup type mismatch" =
   Ocaml_toplevel.eval
-    ~code:
-      {|
+    {|
 module Trait = Provider.Trait.Create1 (struct
   type (!'a, _) t = 'a
   type 'a module_type = 'a