Backport 5.2 build fixes (#2545)

Co-authored-by: Jules Aguillon <[email protected]>
Co-authored-by: Guillaume Petiot <[email protected]>

CHANGES.md

@@ -4,6 +4,12 @@ Items marked with an asterisk (\*) are changes that are likely to format
 existing code differently from the previous release when using the default
 profile. This started with version 0.26.0.
 
+## unreleased
+
+### Changed
+
+- Compatible with OCaml 5.2.0 (#2510, @gpetiot, @Julow)
+
 ## 0.26.1 (2023-09-15)
 
 ### Changed

test/cli/repl_file_errors.t/run.t

@@ -5,25 +5,25 @@ Make sure the locations of errors in repl files are right.
   $ ocamlformat --repl-file line5.repl
   ocamlformat: ignoring "line5.repl" (syntax error)
   File "line5.repl", line 5, characters 12-12:
-  Error: Syntax error: a toplevel phrase must end with `;;`. expected.
+  Error: Syntax error: "a toplevel phrase must end with `;;`." expected.
   [1]
 
   $ ocamlformat --repl-file line6.repl
   ocamlformat: ignoring "line6.repl" (syntax error)
   File "line6.repl", line 6, characters 12-12:
-  Error: Syntax error: a toplevel phrase must end with `;;`. expected.
+  Error: Syntax error: "a toplevel phrase must end with `;;`." expected.
   [1]
 
   $ ocamlformat --repl-file line7.repl
   ocamlformat: ignoring "line7.repl" (syntax error)
   File "line7.repl", line 7, characters 12-12:
-  Error: Syntax error: a toplevel phrase must end with `;;`. expected.
+  Error: Syntax error: "a toplevel phrase must end with `;;`." expected.
   [1]
 
   $ ocamlformat --repl-file missing_semisemi.repl
   ocamlformat: ignoring "missing_semisemi.repl" (syntax error)
   File "missing_semisemi.repl", line 2, characters 10-10:
-  Error: Syntax error: a toplevel phrase must end with `;;`. expected.
+  Error: Syntax error: "a toplevel phrase must end with `;;`." expected.
   [1]
 
   $ ocamlformat --repl-file empty_line_begin.repl

test/failing/tests/module.ml.broken-ref

@@ -2,8 +2,8 @@ ocamlformat: ignoring "tests/module.ml" (syntax error)
 File "tests/module.ml", line 5, characters 18-22:
 5 |       include Foo with type t := t
                       ^^^^
-Error: Syntax error: 'end' expected
+Error: Syntax error: "end" expected
 File "tests/module.ml", line 3, characters 15-21:
 3 |     module G = struct
                    ^^^^^^
-  This 'struct' might be unmatched
+  This "struct" might be unmatched

test/failing/tests/nesting.ml.broken-ref

@@ -1,7 +1,7 @@
 ocamlformat: ignoring "tests/nesting.ml" (syntax error)
 File "tests/nesting.ml", line 35, characters 0-0:
-Error: Syntax error: 'end' expected
+Error: Syntax error: "end" expected
 File "tests/nesting.ml", line 1, characters 11-17:
 1 | module M = struct
                ^^^^^^
-  This 'struct' might be unmatched
+  This "struct" might be unmatched

test/failing/tests/never_align.ml.broken-ref

@@ -2,8 +2,8 @@ ocamlformat: ignoring "tests/never_align.ml" (syntax error)
 File "tests/never_align.ml", line 13, characters 4-5:
 13 |     b
          ^
-Error: Syntax error: '}' expected
+Error: Syntax error: "}" expected
 File "tests/never_align.ml", line 11, characters 8-9:
 11 | let _ = {
              ^
-  This '{' might be unmatched
+  This "{" might be unmatched

test/failing/tests/ppx_stritem_ext.ml.broken-ref

@@ -2,4 +2,4 @@ ocamlformat: ignoring "tests/ppx_stritem_ext.ml" (syntax error)
 File "tests/ppx_stritem_ext.ml", line 10, characters 11-14:
 10 | module S = sig
                 ^^^
-Error: Syntax error: struct expected.
+Error: Syntax error: "struct" expected.

test/unit/test_translation_unit.ml

@@ -67,9 +67,9 @@ let test_parse_and_format_module_type =
            {|test_unit: ignoring "<test>" (syntax error)
 
 File "<test>", line 1, characters 3-3:
-Error: Syntax error: 'end' expected
+Error: Syntax error: "end" expected
 File "<test>", line 1, characters 0-3:
-  This 'sig' might be unmatched
+  This "sig" might be unmatched
 |}
         )
   ; make_test "full sig"

vendor/ocaml-common/location.ml

@@ -147,7 +147,7 @@ let print_updating_num_loc_lines ppf f arg =
   pp_set_formatter_out_functions ppf out_functions
 
 let setup_colors () =
-  Misc.Color.setup !Clflags.color
+  Misc.Style.setup !Clflags.color
 
 (******************************************************************************)
 (* Printing locations, e.g. 'File "foo.ml", line 3, characters 10-12' *)

vendor/ocaml-common/syntaxerr.ml

@@ -15,6 +15,13 @@
 
 (* Auxiliary type for reporting syntax errors *)
 
+type invalid_package_type =
+  | Parameterized_types
+  | Constrained_types
+  | Private_types
+  | Not_with_type
+  | Neither_identifier_nor_with_type
+
 type error =
     Unclosed of Location.t * string * Location.t * string
   | Expecting of Location.t * string
@@ -23,7 +30,7 @@ type error =
   | Variable_in_scope of Location.t * string
   | Other of Location.t
   | Ill_formed_ast of Location.t * string
-  | Invalid_package_type of Location.t * string
+  | Invalid_package_type of Location.t * invalid_package_type
   | Removed_string_set of Location.t
 
 exception Error of error
@@ -37,7 +44,7 @@ let location_of_error = function
   | Not_expecting (l, _)
   | Ill_formed_ast (l, _)
   | Invalid_package_type (l, _)
-  | Expecting (l, _) -> l
+  | Expecting (l, _)
   | Removed_string_set l -> l
 
 

vendor/ocaml-common/syntaxerr.mli

@@ -20,6 +20,13 @@
 
 *)
 
+type invalid_package_type =
+  | Parameterized_types
+  | Constrained_types
+  | Private_types
+  | Not_with_type
+  | Neither_identifier_nor_with_type
+
 type error =
     Unclosed of Location.t * string * Location.t * string
   | Expecting of Location.t * string
@@ -28,7 +35,7 @@ type error =
   | Variable_in_scope of Location.t * string
   | Other of Location.t
   | Ill_formed_ast of Location.t * string
-  | Invalid_package_type of Location.t * string
+  | Invalid_package_type of Location.t * invalid_package_type
   | Removed_string_set of Location.t
 
 exception Error of error

vendor/parser-extended/parse.ml

@@ -138,6 +138,8 @@ let type_ident = wrap Parser.Incremental.parse_mty_longident
 (* Error reporting for Syntaxerr *)
 (* The code has been moved here so that one can reuse Pprintast.tyvar *)
 
+module Style = Misc.Style
+
 let prepare_error err =
   let open Syntaxerr in
   match err with
@@ -146,37 +148,58 @@ let prepare_error err =
         ~loc:closing_loc
         ~sub:[
           Location.msg ~loc:opening_loc
-            "This '%s' might be unmatched" opening
+            "This %a might be unmatched" Style.inline_code opening
         ]
-        "Syntax error: '%s' expected" closing
+        "Syntax error: %a expected" Style.inline_code closing
 
   | Expecting (loc, nonterm) ->
-      Location.errorf ~loc "Syntax error: %s expected." nonterm
+      Location.errorf ~loc "Syntax error: %a expected."
+        Style.inline_code nonterm
   | Not_expecting (loc, nonterm) ->
-      Location.errorf ~loc "Syntax error: %s not expected." nonterm
+      Location.errorf ~loc "Syntax error: %a not expected."
+        Style.inline_code nonterm
   | Applicative_path loc ->
       Location.errorf ~loc
-        "Syntax error: applicative paths of the form F(X).t \
-         are not supported when the option -no-app-func is set."
+        "Syntax error: applicative paths of the form %a \
+         are not supported when the option %a is set."
+        Style.inline_code "F(X).t"
+        Style.inline_code "-no-app-func"
   | Variable_in_scope (loc, var) ->
       Location.errorf ~loc
         "In this scoped type, variable %a \
-         is reserved for the local type %s."
-        Pprintast.tyvar var var
+         is reserved for the local type %a."
+        (Style.as_inline_code Pprintast.tyvar) var
+        Style.inline_code var
   | Other loc ->
       Location.errorf ~loc "Syntax error"
   | Ill_formed_ast (loc, s) ->
       Location.errorf ~loc
         "broken invariant in parsetree: %s" s
-  | Invalid_package_type (loc, s) ->
-      Location.errorf ~loc "invalid package type: %s" s
+  | Invalid_package_type (loc, ipt) ->
+      let invalid ppf ipt = match ipt with
+        | Syntaxerr.Parameterized_types ->
+            Format.fprintf ppf "parametrized types are not supported"
+        | Constrained_types ->
+            Format.fprintf ppf "constrained types are not supported"
+        | Private_types ->
+            Format.fprintf ppf  "private types are not supported"
+        | Not_with_type ->
+            Format.fprintf ppf "only %a constraints are supported"
+              Style.inline_code "with type t ="
+        | Neither_identifier_nor_with_type ->
+            Format.fprintf ppf
+              "only module type identifier and %a constraints are supported"
+              Style.inline_code "with type"
+      in
+      Location.errorf ~loc "invalid package type: %a" invalid ipt
   | Removed_string_set loc ->
       Location.errorf ~loc
         "Syntax error: strings are immutable, there is no assignment \
          syntax for them.\n\
          @{<hint>Hint@}: Mutable sequences of bytes are available in \
          the Bytes module.\n\
-         @{<hint>Hint@}: Did you mean to use 'Bytes.set'?"
+         @{<hint>Hint@}: Did you mean to use %a?"
+        Style.inline_code "Bytes.set"
 let () =
   Location.register_error_of_exn
     (function

vendor/parser-extended/parser.mly

@@ -503,11 +503,11 @@ let package_type_of_module_type pmty =
     | Pwith_type (lid, ptyp) ->
         let loc = ptyp.ptype_loc in
         if ptyp.ptype_params <> [] then
-          err loc "parametrized types are not supported";
+          err loc Syntaxerr.Parameterized_types;
         if ptyp.ptype_cstrs <> [] then
-          err loc "constrained types are not supported";
+          err loc Syntaxerr.Constrained_types;
         if ptyp.ptype_private <> Public then
-          err loc "private types are not supported";
+          err loc Syntaxerr.Private_types;
 
         (* restrictions below are checked by the 'with_constraint' rule *)
         assert (ptyp.ptype_kind = Ptype_abstract);
@@ -519,15 +519,14 @@ let package_type_of_module_type pmty =
         in
         (lid, ty)
     | _ ->
-        err pmty.pmty_loc "only 'with type t =' constraints are supported"
+        err pmty.pmty_loc Not_with_type
   in
   match pmty with
   | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes)
   | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
       (lid, List.map map_cstr cstrs, pmty.pmty_attributes)
   | _ ->
-      err pmty.pmty_loc
-        "only module type identifier and 'with type' constraints are supported"
+      err pmty.pmty_loc Neither_identifier_nor_with_type
 
 let mk_directive_arg ~loc k =
   { pdira_desc = k;

vendor/parser-shims/dune

@@ -1,4 +1,6 @@
 (library
  (name parser_shims)
  (public_name ocamlformat-lib.parser_shims)
+ (flags
+  (:standard -w -37 -w -38))
  (libraries compiler-libs.common))