diff options
| -rw-r--r-- | stm/lemmas.ml | 7 | ||||
| -rw-r--r-- | test-suite/bugs/closed/4818.v | 24 |
2 files changed, 29 insertions, 2 deletions
diff --git a/stm/lemmas.ml b/stm/lemmas.ml index 5b205e79e..1ab695a5f 100644 --- a/stm/lemmas.ml +++ b/stm/lemmas.ml @@ -476,9 +476,11 @@ let save_proof ?proof = function let ctx = Evd.evar_context_universe_context (fst universes) in Admitted(id, k, (const_entry_secctx, pi2 k, (typ, ctx), None), universes) | None -> + let pftree = Pfedit.get_pftreestate () in let id, k, typ = Pfedit.current_proof_statement () in + let universes = Proof.initial_euctx pftree in (* This will warn if the proof is complete *) - let pproofs, universes = + let pproofs, _univs = Proof_global.return_proof ~allow_partial:true () in let sec_vars = match Pfedit.get_used_variables(), pproofs with @@ -490,7 +492,8 @@ let save_proof ?proof = function Some (Environ.keep_hyps env (Idset.union ids_typ ids_def)) | _ -> None in let names = Pfedit.get_universe_binders () in - let binders, ctx = Evd.universe_context ?names (Evd.from_ctx universes) in + let evd = Evd.from_ctx universes in + let binders, ctx = Evd.universe_context ?names evd in Admitted(id,k,(sec_vars, pi2 k, (typ, ctx), None), (universes, Some binders)) in diff --git a/test-suite/bugs/closed/4818.v b/test-suite/bugs/closed/4818.v new file mode 100644 index 000000000..904abb228 --- /dev/null +++ b/test-suite/bugs/closed/4818.v @@ -0,0 +1,24 @@ +(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Prob" "-top" "Product") -*- *) +(* File reduced by coq-bug-finder from original input, then from 391 lines to 77 lines, then from 857 lines to 119 lines, then from 1584 lines to 126 lines, then from 362 lines to 135 lines, then from 149 lines to 135 lines *) +(* coqc version 8.5pl1 (June 2016) compiled on Jun 9 2016 17:27:17 with OCaml 4.02.3 + coqtop version 8.5pl1 (June 2016) *) +Set Universe Polymorphism. + +Inductive GCov (I : Type) : Type := | Foo : I -> GCov I. + +Section Product. + +Variables S IS : Type. +Variable locS : IS -> True. + +Goal GCov (IS * S) -> GCov IS. +intros X0. induction X0; intros. +destruct i. +specialize (locS i). +clear -locS. +destruct locS. Show Universes. +Admitted. + +(* +Anomaly: Universe Product.5189 undefined. Please report. +*) |