Make mdx compatible with ocaml 5.2

realworldocaml · Feb 13, 2024 · 2f5dea6 · 2f5dea6
1 parent b4f4f58
commit 2f5dea6
Show file tree

Hide file tree

Showing 6 changed files with 30 additions and 14 deletions.
diff --git a/lib/top/compat_top.ml b/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
diff --git a/lib/top/compat_top.mli b/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]. *)
diff --git a/lib/top/mdx_top.ml b/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 }
 

diff --git a/test/bin/mdx-test/expect/ocaml-errors-ellipsis/test-case.md b/test/bin/mdx-test/expect/ocaml-errors-ellipsis/test-case.md
@@ -1,13 +1,13 @@
 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
 ```
 ```mdx-error
 ...
-Error: Syntax error: 'end' expected
+Error: Syntax error: end expected
 ...
 ```
 

diff --git a/test/bin/mdx-test/expect/ocaml-errors/test-case.md b/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
 ```
diff --git a/test/bin/mdx-test/expect/ocaml-errors/test-case.md.expected b/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
 ```