Add constraint to ord variant wildcard_case to_int (closes ocaml-ppx#254

)

src_plugins/ord/ppx_deriving_ord.cppo.ml

@@ -35,10 +35,10 @@ let reduce_compare l =
   | [] -> [%expr 0]
   | x :: xs -> List.fold_left compare_reduce x xs
 
-let wildcard_case int_cases =
+let wildcard_case ~typ int_cases =
   let loc = !Ast_helper.default_loc in
   Exp.case [%pat? _] [%expr
-    let to_int = [%e Exp.function_ int_cases] in
+    let to_int: [%t typ] -> Ppx_deriving_runtime.int = [%e Exp.function_ int_cases] in
     Ppx_deriving_runtime.compare (to_int lhs) (to_int rhs)]
 
 let pattn side typs =
@@ -163,7 +163,7 @@ and expr_of_typ quoter typ =
           | _ -> assert false)
       in
       [%expr fun lhs rhs ->
-        [%e Exp.match_ [%expr lhs, rhs] (cases @ [wildcard_case int_cases])]]
+        [%e Exp.match_ [%expr lhs, rhs] (cases @ [wildcard_case ~typ int_cases])]]
     | { ptyp_desc = Ptyp_var name } -> evar ("poly_"^name)
     | { ptyp_desc = Ptyp_alias (typ, _) } -> expr_of_typ typ
     | { ptyp_loc } ->
@@ -208,7 +208,7 @@ let str_of_type ~options ~path ({ ptype_loc = loc } as type_decl) =
           )
       in
       [%expr fun lhs rhs ->
-        [%e Exp.match_ [%expr lhs, rhs] (cases @ [wildcard_case int_cases])]]
+        [%e Exp.match_ [%expr lhs, rhs] (cases @ [wildcard_case ~typ:[%type: Ppx_deriving_ord_helper.t] int_cases])]]
     | Ptype_record labels, _ ->
       let exprs =
         labels |> List.map (fun ({ pld_name = { txt = name }; _ } as pld) ->
@@ -235,9 +235,23 @@ let str_of_type ~options ~path ({ ptype_loc = loc } as type_decl) =
       core_type_of_decl ~options ~path type_decl in
   let out_var =
     pvar (Ppx_deriving.mangle_type_decl (`Prefix "compare") type_decl) in
+  (* Capture type in helper module outside Ppx_deriving_runtime wrapper (added by sanitize).
+     Required for to_int constraint in variant type wildcard_case if the type name
+     conflicts with a Stdlib type from Ppx_deriving_runtime (e.g. bool in test).
+     In that case we must refer to the type being declared, not the one opened by Ppx_deriving_runtime. *)
+  let helper_type =
+    Type.mk ~loc ~attrs:[Ppx_deriving.attr_warning [%expr "-unused-type-declaration"]]
+      ~params:type_decl.ptype_params
+      ~manifest:(Ppx_deriving.core_type_of_type_decl type_decl)
+      (mkloc "t" loc)
+  in
+  let comparator_with_helper =
+    [%expr let module Ppx_deriving_ord_helper = struct [%%i Str.type_ Nonrecursive [helper_type]] end in
+           [%e Ppx_deriving.sanitize ~quoter (eta_expand (polymorphize comparator))]]
+  in
   [Vb.mk ~attrs:[Ppx_deriving.attr_warning [%expr "-39"]]
          (Pat.constraint_ out_var out_type)
-         (Ppx_deriving.sanitize ~quoter (eta_expand (polymorphize comparator)))]
+         comparator_with_helper]
 
 let () =
   Ppx_deriving.(register (create deriver