Merge pull request #62 from Ngoguey42/clean-error-on-polyvar-inherit

Improve error on polyvar inherit case with ppx_repr

src/ppx_repr/lib/engine.ml

@@ -77,6 +77,10 @@ module Located (Attributes : Attributes.S) (A : Ast_builder.S) : S = struct
       #core_type
       typ false
 
+  let rowfield_is_inherit = function
+    | { prf_desc = Rinherit _; _ } -> true
+    | _ -> false
+
   let rec derive_core typ =
     let* { type_name; lib; var_repr; _ } = ask in
     let loc = typ.ptyp_loc in
@@ -95,6 +99,8 @@ module Located (Attributes : Attributes.S) (A : Ast_builder.S) : S = struct
             pexp_apply (pexp_ident lident) cons_args)
     | Ptyp_variant (_, Open, _) -> Raise.Unsupported.type_open_polyvar ~loc typ
     | Ptyp_variant (rowfields, Closed, _labellist) ->
+        if List.exists rowfield_is_inherit rowfields then
+          Raise.Unsupported.polyvar_inherit_case ~loc typ;
         derive_polyvariant type_name rowfields
     | Ptyp_poly _ -> Raise.Unsupported.type_poly ~loc typ
     | Ptyp_tuple args -> derive_tuple args

src/ppx_repr/lib/raise.ml

@@ -44,6 +44,12 @@ module Unsupported = struct
        be closed."
       name Pprintast.core_type ctyp
 
+  let polyvar_inherit_case ~loc ctyp =
+    Location.raise_errorf ~loc
+      "%s: inherited variant cases encountered in %a. This is unsupported by \
+       ppx_repr."
+      name Pprintast.core_type ctyp
+
   let type_package ~loc ctyp =
     Location.raise_errorf ~loc
       "%s: package type %a encountered. Package types are not \

src/ppx_repr/lib/raise.mli

@@ -22,6 +22,7 @@ module Unsupported : sig
   val type_open : loc:location -> _
   val type_poly : loc:location -> core_type -> _
   val type_open_polyvar : loc:location -> core_type -> _
+  val polyvar_inherit_case : loc:location -> core_type -> _
   val type_package : loc:location -> core_type -> _
   val type_extension : loc:location -> core_type -> _
   val type_alias : loc:location -> core_type -> _

test/ppx_repr/deriver/errors/dune.inc

@@ -97,6 +97,30 @@
   (diff recursion_with_type_parameters.expected
     recursion_with_type_parameters.actual)))
 
+; -------- Test: `unsupported_polyvar_inherit_case.ml` --------
+
+
+
+; Run the PPX on the `.ml` file
+(rule
+ (targets unsupported_polyvar_inherit_case.actual)
+ (deps
+  (:pp pp.exe)
+  (:input unsupported_polyvar_inherit_case.ml))
+ (action
+  ; expect the process to fail, capturing stderr
+  (with-stderr-to
+   %{targets}
+   (bash "! ./%{pp} -no-color --impl %{input}"))))
+
+; Compare the post-processed output to the .expected file
+(rule
+ (alias runtest)
+ (package ppx_repr)
+ (action
+  (diff unsupported_polyvar_inherit_case.expected
+    unsupported_polyvar_inherit_case.actual)))
+
 ; -------- Test: `unsupported_tuple_size.ml` --------
 
 

test/ppx_repr/deriver/errors/unsupported_polyvar_inherit_case.expected

@@ -0,0 +1,2 @@
+File "unsupported_polyvar_inherit_case.ml", line 2, characters 9-19:
+Error: ppx_repr: inherited variant cases encountered in [ | s | `T ]. This is unsupported by ppx_repr.

test/ppx_repr/deriver/errors/unsupported_polyvar_inherit_case.ml

@@ -0,0 +1,2 @@
+type s = [ `S ] [@@deriving repr]
+type t = [ s | `T ] [@@deriving repr]