aboutsummaryrefslogtreecommitdiff
path: root/test-suite
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite')
-rw-r--r--test-suite/bugs/closed/2378.v2
-rw-r--r--test-suite/bugs/closed/6313.v64
-rw-r--r--test-suite/bugs/opened/1596.v1
-rw-r--r--test-suite/failure/fixpointeta.v70
-rw-r--r--test-suite/output/Arguments_renaming.out2
-rw-r--r--test-suite/output/Existentials.out6
-rw-r--r--test-suite/output/Notations3.out8
-rw-r--r--test-suite/output/inference.out8
-rw-r--r--test-suite/success/Hints.v11
-rw-r--r--test-suite/success/ShowExtraction.v31
10 files changed, 188 insertions, 15 deletions
diff --git a/test-suite/bugs/closed/2378.v b/test-suite/bugs/closed/2378.v
index 85ad41d1cf..23a58501f3 100644
--- a/test-suite/bugs/closed/2378.v
+++ b/test-suite/bugs/closed/2378.v
@@ -505,8 +505,6 @@ Qed.
Require Export Coq.Logic.FunctionalExtensionality.
Print PLanguage.
-Unset Standard Proposition Elimination Names.
-
Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr):
Transformation (PLanguage l1) (PLanguage l2) :=
mkTransformation (PLanguage l1) (PLanguage l2)
diff --git a/test-suite/bugs/closed/6313.v b/test-suite/bugs/closed/6313.v
new file mode 100644
index 0000000000..4d263c5a82
--- /dev/null
+++ b/test-suite/bugs/closed/6313.v
@@ -0,0 +1,64 @@
+(* Former open goals in nested proofs were lost *)
+
+(* This used to fail with "Incorrect number of goals (expected 1 tactic)." *)
+
+Inductive foo := a | b | c.
+Goal foo -> foo.
+ intro x.
+ simple refine (match x with
+ | a => _
+ | b => ltac:(exact b)
+ | c => _
+ end); [exact a|exact c].
+Abort.
+
+(* This used to leave the goal on the shelf and fails at reflexivity *)
+
+Goal (True/\0=0 -> True) -> True.
+ intro f.
+ refine
+ (f ltac:(split; only 1:exact I)).
+ reflexivity.
+Qed.
+
+(* The "Unshelve" used to not see the explicitly "shelved" goal *)
+
+Lemma f (b:comparison) : b=b.
+refine (match b with
+ Eq => ltac:(shelve)
+ | Lt => ltac:(give_up)
+ | Gt => _
+ end).
+exact (eq_refl Gt).
+Unshelve.
+exact (eq_refl Eq).
+Fail auto. (* Check that there are no more regular subgoals *)
+Admitted.
+
+(* The "Unshelve" used to not see the explicitly "shelved" goal *)
+
+Lemma f2 (b:comparison) : b=b.
+refine (match b with
+ Eq => ltac:(shelve)
+ | Lt => ltac:(give_up)
+ | Gt => _
+ end).
+Unshelve. (* Note: Unshelve puts goals at the end *)
+exact (eq_refl Gt).
+exact (eq_refl Eq).
+Fail auto. (* Check that there are no more regular subgoals *)
+Admitted.
+
+(* The "unshelve" used to not see the explicitly "shelved" goal *)
+
+Lemma f3 (b:comparison) : b=b.
+unshelve refine (match b with
+ Eq => ltac:(shelve)
+ | Lt => ltac:(give_up)
+ | Gt => _
+ end).
+(* Note: unshelve puts goals at the beginning *)
+exact (eq_refl Eq).
+exact (eq_refl Gt).
+Fail auto. (* Check that there are no more regular subgoals *)
+Admitted.
diff --git a/test-suite/bugs/opened/1596.v b/test-suite/bugs/opened/1596.v
index 0b576db6b3..820022d995 100644
--- a/test-suite/bugs/opened/1596.v
+++ b/test-suite/bugs/opened/1596.v
@@ -2,7 +2,6 @@ Require Import Relations.
Require Import FSets.
Require Import Arith.
Require Import Omega.
-Unset Standard Proposition Elimination Names.
Set Keyed Unification.
diff --git a/test-suite/failure/fixpointeta.v b/test-suite/failure/fixpointeta.v
new file mode 100644
index 0000000000..9af719322f
--- /dev/null
+++ b/test-suite/failure/fixpointeta.v
@@ -0,0 +1,70 @@
+
+Set Primitive Projections.
+
+Record R := C { p : nat }.
+(* R is defined
+p is defined *)
+
+Unset Primitive Projections.
+Record R' := C' { p' : nat }.
+
+
+
+Fail Definition f := fix f (x : R) : nat := p x.
+(** Not allowed to make fixpoint defs on (non-recursive) records
+ having eta *)
+
+Fail Definition f := fix f (x : R') : nat := p' x.
+(** Even without eta (R' is not primitive here), as long as they're
+ found to be BiFinite (non-recursive), we disallow it *)
+
+(*
+
+(* Subject reduction failure example, if we allowed fixpoints *)
+
+Set Primitive Projections.
+
+Record R := C { p : nat }.
+
+Definition f := fix f (x : R) : nat := p x.
+
+(* eta rule for R *)
+Definition Rtr (P : R -> Type) x (v : P (C (p x))) : P x
+ := v.
+
+Definition goal := forall x, f x = p x.
+
+(* when we compute the Rtr away typechecking will fail *)
+Definition thing : goal := fun x =>
+(Rtr (fun x => f x = p x) x (eq_refl _)).
+
+Definition thing' := Eval compute in thing.
+
+Fail Check (thing = thing').
+(*
+The command has indeed failed with message:
+The term "thing'" has type "forall x : R, (let (p) := x in p) = (let (p) := x in p)"
+while it is expected to have type "goal" (cannot unify "(let (p) := x in p) = (let (p) := x in p)"
+and "f x = p x").
+*)
+
+Definition thing_refl := eq_refl thing.
+
+Fail Definition thing_refl' := Eval compute in thing_refl.
+(*
+The command has indeed failed with message:
+Illegal application:
+The term "@eq_refl" of type "forall (A : Type) (x : A), x = x"
+cannot be applied to the terms
+ "forall x : R, (fix f (x0 : R) : nat := let (p) := x0 in p) x = (let (p) := x in p)" : "Prop"
+ "fun x : R => eq_refl" : "forall x : R, (let (p) := x in p) = (let (p) := x in p)"
+The 2nd term has type "forall x : R, (let (p) := x in p) = (let (p) := x in p)"
+which should be coercible to
+ "forall x : R, (fix f (x0 : R) : nat := let (p) := x0 in p) x = (let (p) := x in p)".
+ *)
+
+Definition more_refls : thing_refl = thing_refl.
+Proof.
+ compute. reflexivity.
+Fail Defined. Abort.
+ *)
diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out
index 4df21ae353..e73312c679 100644
--- a/test-suite/output/Arguments_renaming.out
+++ b/test-suite/output/Arguments_renaming.out
@@ -11,7 +11,7 @@ notation scopes add ': clear scopes' [arguments-assert,vernacular]
eq_refl
: ?y = ?y
where
-?y : [ |- nat]
+?y : [ |- nat]
Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x
For eq_refl: Arguments are renamed to B, y
diff --git a/test-suite/output/Existentials.out b/test-suite/output/Existentials.out
index 9680d2bbff..18f5d89f66 100644
--- a/test-suite/output/Existentials.out
+++ b/test-suite/output/Existentials.out
@@ -1,4 +1,4 @@
-Existential 1 = ?Goal : [p : nat q := S p : nat n : nat m : nat |- ?y = m]
+Existential 1 = ?Goal : [p : nat q := S p : nat n : nat m : nat |- ?y = m]
Existential 2 =
-?y : [p : nat q := S p : nat n : nat m : nat |- nat] (p, q cannot be used)
-Existential 3 = ?Goal0 : [q : nat n : nat m : nat |- n = ?y]
+?y : [p : nat q := S p : nat n : nat m : nat |- nat] (p, q cannot be used) (shelved)
+Existential 3 = ?Goal0 : [q : nat n : nat m : nat |- n = ?y]
diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out
index e6a6e0288a..864b6151a1 100644
--- a/test-suite/output/Notations3.out
+++ b/test-suite/output/Notations3.out
@@ -33,24 +33,24 @@ fun f : forall x : nat * (bool * unit), ?T => CURRY (x : nat) (y : bool), f
: (forall x : nat * (bool * unit), ?T) ->
forall (x : nat) (y : bool), ?T@{x:=(x, (y, tt))}
where
-?T : [x : nat * (bool * unit) |- Type]
+?T : [x : nat * (bool * unit) |- Type]
fun f : forall x : bool * (nat * unit), ?T =>
CURRYINV (x : nat) (y : bool), f
: (forall x : bool * (nat * unit), ?T) ->
forall (x : nat) (y : bool), ?T@{x:=(y, (x, tt))}
where
-?T : [x : bool * (nat * unit) |- Type]
+?T : [x : bool * (nat * unit) |- Type]
fun f : forall x : unit * nat * bool, ?T => CURRYLEFT (x : nat) (y : bool), f
: (forall x : unit * nat * bool, ?T) ->
forall (x : nat) (y : bool), ?T@{x:=(tt, x, y)}
where
-?T : [x : unit * nat * bool |- Type]
+?T : [x : unit * nat * bool |- Type]
fun f : forall x : unit * bool * nat, ?T =>
CURRYINVLEFT (x : nat) (y : bool), f
: (forall x : unit * bool * nat, ?T) ->
forall (x : nat) (y : bool), ?T@{x:=(tt, y, x)}
where
-?T : [x : unit * bool * nat |- Type]
+?T : [x : unit * bool * nat |- Type]
forall n : nat, {#n | 1 > n}
: Prop
forall x : nat, {|x | x > 0|}
diff --git a/test-suite/output/inference.out b/test-suite/output/inference.out
index d28ee42761..5e9eff0481 100644
--- a/test-suite/output/inference.out
+++ b/test-suite/output/inference.out
@@ -9,10 +9,10 @@ fun (m n p : nat) (H : S m <= S n + p) => le_S_n m (n + p) H
fun n : nat => let y : T n := A n in ?t ?x : T n
: forall n : nat, T n
where
-?t : [n : nat y := A n : T n |- ?T -> T n]
-?x : [n : nat y := A n : T n |- ?T]
+?t : [n : nat y := A n : T n |- ?T -> T n]
+?x : [n : nat y := A n : T n |- ?T]
fun n : nat => ?t ?x : T n
: forall n : nat, T n
where
-?t : [n : nat |- ?T -> T n]
-?x : [n : nat |- ?T]
+?t : [n : nat |- ?T -> T n]
+?x : [n : nat |- ?T]
diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v
index 6962e43e7e..8d08f5975e 100644
--- a/test-suite/success/Hints.v
+++ b/test-suite/success/Hints.v
@@ -172,3 +172,14 @@ Hint Cut [_* (a_is_b | b_is_c | c_is_d | d_is_e)
Timeout 1 Fail apply _. (* 0.06s *)
Abort.
End HintCut.
+
+
+(* Check that auto-like tactics do not prefer "eq_refl" over more complex solutions, *)
+(* e.g. those tactics when considering a goal with existential varibles *)
+(* like "m = ?n" won't pick "plus_n_O" hint over "eq_refl" hint. *)
+(* See this Coq club post for more detail: *)
+(* https://sympa.inria.fr/sympa/arc/coq-club/2017-12/msg00103.html *)
+
+Goal forall (m : nat), exists n, m = n /\ m = n.
+ intros m; eexists; split; [trivial | reflexivity].
+Qed.
diff --git a/test-suite/success/ShowExtraction.v b/test-suite/success/ShowExtraction.v
new file mode 100644
index 0000000000..e34c240c5d
--- /dev/null
+++ b/test-suite/success/ShowExtraction.v
@@ -0,0 +1,31 @@
+
+Require Extraction.
+Require Import List.
+
+Section Test.
+Variable A : Type.
+Variable decA : forall (x y:A), {x=y}+{x<>y}.
+
+(** Should fail when no proofs are started *)
+Fail Show Extraction.
+
+Lemma decListA : forall (xs ys : list A), {xs=ys}+{xs<>ys}.
+Proof.
+Show Extraction.
+fix 1.
+destruct xs as [|x xs], ys as [|y ys].
+Show Extraction.
+- now left.
+- now right.
+- now right.
+- Show Extraction.
+ destruct (decA x y).
+ + destruct (decListA xs ys).
+ * left; now f_equal.
+ * Show Extraction.
+ right. congruence.
+ + right. congruence.
+Show Extraction.
+Defined.
+
+End Test.
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-03 10:07:19 +0000