Merge pull request #448 from gpetiot/5.2

Make mdx compatible with ocaml 5.2

Author: gpetiot

CHANGES.md

@@ -4,6 +4,7 @@
 
 - Handle the error-blocks syntax (#439, @jonludlam, @gpetiot)
 - Allow execution of included OCaml code blocks (#446, @panglesd)
+- Make MDX compatible with OCaml 5.2 (#448, @gpetiot)
 
 #### Fixed
 

lib/block.ml

@@ -177,8 +177,7 @@ let pp_contents ?syntax:_ ppf t =
 
 let rec error_padding = function
   | [] -> []
-  | [ (`Output _ as o); `Output padding ] when Util.String.all_blank padding ->
-      [ o ]
+  | [ o; `Output padding ] when Util.String.all_blank padding -> [ o ]
   | x :: xs ->
       let xs = error_padding xs in
       x :: xs

lib/top/compat_top.ml

@@ -280,3 +280,19 @@ let get_id_opt = function
 #if OCAML_VERSION >= (5, 1, 0)
   | Path.Pextra_ty _ -> None
 #endif
+
+let mk_fun loc exp =
+  let punit =
+    Ast_helper.Pat.construct (Location.mkloc (Longident.Lident "()") loc) None
+  in
+  let label = Asttypes.Nolabel in
+  let default = None in
+#if OCAML_VERSION >= (5, 2, 0)
+  let param =
+    { Parsetree.pparam_loc= loc
+    ; pparam_desc= Pparam_val (label, default, punit) }
+  in
+  Ast_helper.Exp.function_ [param] None (Pfunction_body exp)
+#else
+  Ast_helper.Exp.fun_ label default punit exp
+#endif

lib/top/compat_top.mli

@@ -69,3 +69,6 @@ val execute_phrase :
 val redirect_directive : string -> string
 val get_id_in_path : Path.t -> Ident.t
 val get_id_opt : Path.t -> Ident.t option
+
+val mk_fun : Location.t -> Parsetree.expression -> Parsetree.expression
+(** [mk_fun loc e] produces [fun () -> e]. *)

lib/top/mdx_top.ml

@@ -196,13 +196,10 @@ module Rewrite = struct
     let preload = None in
     let open Ast_helper in
     let rewrite loc e =
-      let punit =
-        Pat.construct (Location.mkloc (Longident.Lident "()") loc) None
-      in
       with_default_loc loc @@ fun () ->
       Exp.apply
         (Exp.ident (Location.mkloc runner loc))
-        [ (Asttypes.Nolabel, Exp.fun_ Asttypes.Nolabel None punit e) ]
+        [ (Asttypes.Nolabel, Compat_top.mk_fun loc e) ]
     in
     { typ; rewrite; witness; preload }
 

test/bin/mdx-test/expect/ocaml-errors-ellipsis/test-case.md

@@ -1,6 +1,6 @@
 It is possible to use ellipsis (`...`) in the error blocks attached to OCaml blocks, here it is useful as the error message depends on the OCaml version:
 
-```ocaml
+```ocaml version<5.2
 module Counter: Irmin.Contents.S with type t = int64 = struct
   type t = int64
   let t = Irmin.Type.int64

test/bin/mdx-test/expect/ocaml-errors/test-case.md

@@ -14,16 +14,16 @@ Error: This 'struct' might be unmatched
 ```
 
 
-```ocaml version>=4.08
+```ocaml version>=5.2
 module Counter: Irmin.Contents.S with type t = int64 = struct
   type t = int64
   let t = Irmin.Type.int64
 ```
 ```mdx-error
 Line 4, characters 3-3:
-Error: Syntax error: 'end' expected
+Error: Syntax error: end expected
 Line 1, characters 56-62:
-  This 'struct' might be unmatched
+  This struct might be unmatched
 ```
 
 
@@ -44,7 +44,7 @@ end
 ```
 ```mdx-error
 Line 4, characters 3-3:
-Error: Syntax error: 'end' expected
+Error: Syntax error: end expected
 Line 1, characters 56-62:
-  This 'struct' might be unmatched
+  This struct might be unmatched
 ```

test/bin/mdx-test/expect/ocaml-errors/test-case.md.expected

@@ -14,16 +14,16 @@ Error: This 'struct' might be unmatched
 ```
 
 
-```ocaml version>=4.08
+```ocaml version>=5.2
 module Counter: Irmin.Contents.S with type t = int64 = struct
   type t = int64
   let t = Irmin.Type.int64
 ```
 ```mdx-error
 Line 4, characters 3-3:
-Error: Syntax error: 'end' expected
+Error: Syntax error: end expected
 Line 1, characters 56-62:
-  This 'struct' might be unmatched
+  This struct might be unmatched
 ```