diff options
| author | Pierre-Marie Pédrot | 2019-05-28 00:37:58 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2019-05-28 10:43:09 +0200 |
| commit | 14da886bf69c13bdd5f8d700351c8253ff7f6981 (patch) | |
| tree | cbbb2e5b9c2006d40c60f1a96969cff68fa60d6d | |
| parent | e005f390312b8900df36aa27bc087e18701c8fcd (diff) | |
Fix #10264: Singleton class field data is erroneous.
| -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 |