diff options
| author | Matthieu Sozeau | 2019-06-04 17:41:59 +0200 |
|---|---|---|
| committer | Matthieu Sozeau | 2019-06-04 17:41:59 +0200 |
| commit | e9c42c26d1fc653d1411fa2fe41b12bffa8ae992 (patch) | |
| tree | 6aa804c3fc51b6150d628964da7999038e64789c | |
| parent | 589aaf4f97d5cfcdabfda285739228f5ee52261f (diff) | |
| parent | 14da886bf69c13bdd5f8d700351c8253ff7f6981 (diff) | |
Merge PR #10265: Fix #10264: Singleton class field data is erroneous.
Reviewed-by: mattam82
| -rw-r--r-- | test-suite/bugs/closed/bug_10264.v | 10 | ||||
| -rw-r--r-- | vernac/record.ml | 6 |
2 files changed, 14 insertions, 2 deletions
diff --git a/test-suite/bugs/closed/bug_10264.v b/test-suite/bugs/closed/bug_10264.v new file mode 100644 index 0000000000..8351f8325b --- /dev/null +++ b/test-suite/bugs/closed/bug_10264.v @@ -0,0 +1,10 @@ +Require Import Program.Tactics. + +Definition bla (A:Type) := A. +Existing Class bla. + +Program Instance fubar : bla nat := {}. +Next Obligation. +Fail exact bool. +exact 0. +Qed. diff --git a/vernac/record.ml b/vernac/record.ml index f737a8c524..d617b13db4 100644 --- a/vernac/record.ml +++ b/vernac/record.ml @@ -588,12 +588,14 @@ let declare_class def cum ubinders univs id idbuild paramimpls params arity let add_constant_class env sigma cst = let ty, univs = Typeops.type_of_global_in_context env (ConstRef cst) in let r = (Environ.lookup_constant cst env).const_relevance in - let ctx, arity = decompose_prod_assum ty in + let ctx, _ = decompose_prod_assum ty in + let args = Context.Rel.to_extended_vect Constr.mkRel 0 ctx in + let t = mkApp (mkConstU (cst, Univ.make_abstract_instance univs), args) in let tc = { cl_univs = univs; cl_impl = ConstRef cst; cl_context = (List.map (const None) ctx, ctx); - cl_props = [LocalAssum (make_annot Anonymous r, arity)]; + cl_props = [LocalAssum (make_annot Anonymous r, t)]; cl_projs = []; cl_strict = !typeclasses_strict; cl_unique = !typeclasses_unique |