Merge PR #12929: Make abstract compatible with mangle names

Reviewed-by: jashug
Reviewed-by: ppedrot

4 files changed, 50 insertions, 34 deletions

diff --git a/tactics/abstract.ml b/tactics/abstract.ml
index 6b575d0807..83ae3ea09a 100644
--- a/tactics/abstract.ml
+++ b/tactics/abstract.ml
@@ -60,33 +60,39 @@ let cache_term_by_tactic_then ~opaque ~name_op ?(goal_type=None) tac tacK =
   in
   let name = name_op_to_name ~name_op ~name suffix in
   Proofview.Goal.enter begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
-  let current_sign = Global.named_context_val ()
-  and global_sign = Proofview.Goal.hyps gl in
-  let sign,secsign =
-    List.fold_right
-      (fun d (s1,s2) ->
-        let id = NamedDecl.get_id d in
-        if mem_named_context_val id current_sign &&
-          interpretable_as_section_decl env sigma (lookup_named_val id current_sign) d
-        then (s1,push_named_context_val d s2)
-        else (Context.Named.add d s1,s2))
-      global_sign (Context.Named.empty, Environ.empty_named_context_val) in
-  let name = Namegen.next_global_ident_away name (pf_ids_set_of_hyps gl) in
-  let concl = match goal_type with
-              | None ->  Proofview.Goal.concl gl
-              | Some ty -> ty in
-  let concl = it_mkNamedProd_or_LetIn concl sign in
-  let solve_tac = tclCOMPLETE (tclTHEN (tclDO (List.length sign) Tactics.intro) tac) in
-  let effs, sigma, lem, args, safe =
-    !declare_abstract ~name ~poly ~sign ~secsign ~kind ~opaque ~solve_tac sigma concl in
-  let solve =
-    Proofview.tclEFFECTS effs <*>
-    tacK lem args
-  in
-  let tac = if not safe then Proofview.mark_as_unsafe <*> solve else solve in
-  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
+    let env = Proofview.Goal.env gl in
+    let sigma = Proofview.Goal.sigma gl in
+    let section_sign = Global.named_context_val () in
+    let goal_sign = Proofview.Goal.hyps gl in
+    let sign,secsign =
+      List.fold_right
+        (fun d (s1,s2) ->
+           let id = NamedDecl.get_id d in
+           if mem_named_context_val id section_sign &&
+              interpretable_as_section_decl env sigma (lookup_named_val id section_sign) d
+           then (s1,push_named_context_val d s2)
+           else (Context.Named.add d s1,s2))
+        goal_sign (Context.Named.empty, Environ.empty_named_context_val)
+    in
+    let name = Namegen.next_global_ident_away name (pf_ids_set_of_hyps gl) in
+    let concl = match goal_type with
+      | None ->  Proofview.Goal.concl gl
+      | Some ty -> ty
+    in
+    let concl = it_mkNamedProd_or_LetIn concl sign in
+    let solve_tac = tclCOMPLETE
+        (Tactics.intros_mustbe_force (List.rev_map NamedDecl.get_id sign) <*>
+         tac)
+    in
+    let effs, sigma, lem, args, safe =
+      !declare_abstract ~name ~poly ~sign ~secsign ~kind ~opaque ~solve_tac sigma concl
+    in
+    let solve =
+      Proofview.tclEFFECTS effs <*>
+      tacK lem args
+    in
+    let tac = if not safe then Proofview.mark_as_unsafe <*> solve else solve in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
   end
 
 let abstract_subproof ~opaque tac =
diff --git a/test-suite/bugs/closed/bug_12928.v b/test-suite/bugs/closed/bug_12928.v
new file mode 100644
index 0000000000..2f4d1dd16d
--- /dev/null
+++ b/test-suite/bugs/closed/bug_12928.v
@@ -0,0 +1,7 @@
+
+Lemma test: forall (x:bool) (x: nat), nat.
+Proof. intros y x; abstract (exact x). Qed.
+
+Set Mangle Names.
+Lemma test': forall x : nat, nat.
+Proof. intros x. abstract exact x. Qed.
diff --git a/test-suite/bugs/closed/bug_3146.v b/test-suite/bugs/closed/bug_3146.v
new file mode 100644
index 0000000000..c42e28818a
--- /dev/null
+++ b/test-suite/bugs/closed/bug_3146.v
@@ -0,0 +1,5 @@
+Axiom x : True.
+Goal nat -> nat.
+  intro x.
+  abstract (exact x).
+Qed.
diff --git a/test-suite/success/name_mangling.v b/test-suite/success/name_mangling.v
index e982414206..d99e407b0d 100644
--- a/test-suite/success/name_mangling.v
+++ b/test-suite/success/name_mangling.v
@@ -1,7 +1,6 @@
-(* -*- coq-prog-args: ("-mangle-names" "_") -*- *)
+Set Mangle Names.
 
 (* Check that refine policy of redefining previous names make these names private *)
-(* abstract can change names in the environment! See bug #3146 *)
 
 Goal True -> True.
 intro.
@@ -58,7 +57,7 @@ Abort.
 
 Goal False -> False.
 intro H.
-Fail abstract exact H.
+abstract exact H.
 Abort.
 
 (* Variant *)
@@ -70,12 +69,11 @@ Abort.
 
 (* Example from Jason *)
 
-Goal False -> False.
+Lemma lem1 : False -> False.
 intro H.
 (* Name H' is from Ltac here, so it preserves the privacy *)
 (* But abstract messes everything up *)
-Fail let H' := H in abstract exact H'.
-let H' := H in exact H'.
+let H' := H in abstract exact H'.
 Qed.
 
 (* Variant *)
@@ -111,7 +109,7 @@ Goal forall b : False, b = b.
 Fail destruct b0.
 Abort.
 
-Goal forall b : False, b = b.
+Lemma lem2 : forall b : False, b = b.
 now destruct b.
 Qed.
 End foo.