Merge pull request #519 from NathanReb/fix-roundtrip-check

Fix roundtrip check to support 5.1 <-> 5.2 migrations

CHANGES.md

@@ -14,6 +14,9 @@ details.
 
 ### Other changes
 
+- Fix `deriving_inline` round-trip check so that it works with 5.01 <-> 5.02
+  migrations (#519, @NathanReb)
+
 0.33.0 (2024-07-22)
 -------------------
 

astlib/astlib.ml

@@ -89,6 +89,12 @@ module Location = Location
 module Longident = Longident
 module Parse = Parse
 module Pprintast = Pprintast
+module Compiler_pprintast = struct
+  include Ocaml_common.Pprintast
+
+  let structure_item fmt t = structure fmt [t]
+  let signature_item fmt t = signature fmt [t]
+end
 
 let init_error_reporting_style_using_env_vars () =
   (*IF_AT_LEAST 408 Ocaml_common.Compmisc.read_clflags_from_env () *)

src/code_matcher.ml

@@ -20,6 +20,7 @@ end
 
 module Make (M : sig
   type t
+  type compiler_t
 
   val get_loc : t -> Location.t
   val end_marker : (t, unit) Attribute.Floating.t
@@ -33,8 +34,9 @@ module Make (M : sig
   end
 
   val parse : Lexing.lexbuf -> t list
-  val pp : Format.formatter -> t -> unit
   val to_sexp : t -> Sexp.t
+  val to_compiler : t -> compiler_t
+  val pp_compiler : Format.formatter -> compiler_t -> unit
 end) =
 struct
   let extract_prefix ~pos l =
@@ -112,6 +114,21 @@ struct
   let parse_string s =
     match M.parse (Lexing.from_string s) with [ x ] -> x | _ -> assert false
 
+  (* To round trip our AST we convert it to the compiler's version, print it as
+     source using the compiler pretty-printers, parse it back using the
+     compiler's parser and migrate it back to our version.
+
+     Skipping the first migration can lead to errors because some subtleties may
+     be lost by older parsers. For instance in OCaml 5.02 [fun x y -> z] and
+     [fun x -> fun y -> z] have different representation but in OCaml 5.01 they
+     both parse to the same AST. Running the migration to the compiler AST first
+     anotates the AST using attributes allowing the final migration to preserve
+     such differences. *)
+  let round_trip ast =
+    let compiler_ast = M.to_compiler ast in
+    remove_loc
+      (parse_string (Format.asprintf "%a@." M.pp_compiler compiler_ast))
+
   let rec match_loop ~end_pos ~mismatch_handler ~expected ~source =
     match (expected, source) with
     | [], [] -> ()
@@ -130,9 +147,7 @@ struct
         let x = remove_loc x in
         let y = remove_loc y in
         if Poly.( <> ) x y then (
-          let round_trip =
-            remove_loc (parse_string (Format.asprintf "%a@." M.pp x))
-          in
+          let round_trip = round_trip x in
           if Poly.( <> ) x round_trip then
             Location.raise_errorf ~loc
               "ppxlib: the corrected code doesn't round-trip.\n\
@@ -151,6 +166,7 @@ end
 (*$*)
 module Str = Make (struct
   type t = structure_item
+  type compiler_t = Ppxlib_ast.Compiler_version.Ast.Parsetree.structure_item
 
   let get_loc x = x.pstr_loc
   let end_marker = end_marker_str
@@ -160,13 +176,15 @@ module Str = Make (struct
   end
 
   let parse = Parse.implementation
-  let pp = Pprintast.structure_item
   let to_sexp = Ast_traverse.sexp_of#structure_item
+  let to_compiler = Ppxlib_ast.Selected_ast.To_ocaml.copy_structure_item
+  let pp_compiler = Astlib.Compiler_pprintast.structure_item
 end)
 
 (*$ str_to_sig _last_text_block *)
 module Sig = Make (struct
   type t = signature_item
+  type compiler_t = Ppxlib_ast.Compiler_version.Ast.Parsetree.signature_item
 
   let get_loc x = x.psig_loc
   let end_marker = end_marker_sig
@@ -176,8 +194,9 @@ module Sig = Make (struct
   end
 
   let parse = Parse.interface
-  let pp = Pprintast.signature_item
   let to_sexp = Ast_traverse.sexp_of#signature_item
+  let to_compiler = Ppxlib_ast.Selected_ast.To_ocaml.copy_signature_item
+  let pp_compiler = Astlib.Compiler_pprintast.signature_item
 end)
 
 (*$*)