diff --git a/CHANGES.md b/CHANGES.md index 484d3149..fe24318f 100644 --- a/CHANGES.md +++ b/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) ------------------- diff --git a/astlib/astlib.ml b/astlib/astlib.ml index 007aaf36..604450db 100644 --- a/astlib/astlib.ml +++ b/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 () *) diff --git a/src/code_matcher.ml b/src/code_matcher.ml index 052d2387..27cc24c8 100644 --- a/src/code_matcher.ml +++ b/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) (*$*)