aboutsummaryrefslogtreecommitdiff
path: root/test-suite
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite')
-rw-r--r--test-suite/Makefile17
-rw-r--r--test-suite/README.md14
-rw-r--r--test-suite/bugs/7333.v39
-rw-r--r--test-suite/bugs/closed/4403.v3
-rw-r--r--test-suite/bugs/closed/4882.v50
-rw-r--r--test-suite/bugs/closed/5539.v15
-rw-r--r--test-suite/bugs/closed/6770.v7
-rw-r--r--test-suite/bugs/closed/6951.v2
-rw-r--r--test-suite/bugs/closed/7011.v16
-rw-r--r--test-suite/bugs/closed/7068.v6
-rw-r--r--test-suite/bugs/closed/7076.v4
-rw-r--r--test-suite/bugs/closed/7113.v10
-rw-r--r--test-suite/bugs/closed/7195.v12
-rw-r--r--test-suite/bugs/closed/7392.v9
-rw-r--r--test-suite/bugs/closed/7631.v21
-rw-r--r--test-suite/coqchk/bug_7539.v26
-rw-r--r--test-suite/output/Arguments_renaming.out6
-rw-r--r--test-suite/success/Fixpoint.v30
-rw-r--r--test-suite/success/ImplicitTactic.v16
19 files changed, 228 insertions, 75 deletions
diff --git a/test-suite/Makefile b/test-suite/Makefile
index ce21ff41c3..32e245e362 100644
--- a/test-suite/Makefile
+++ b/test-suite/Makefile
@@ -25,7 +25,7 @@
# Includes
###########################################################################
-include ../config/Makefile
+-include ../config/Makefile
include ../Makefile.common
#######################################################################
@@ -362,26 +362,33 @@ $(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out $(PREREQUISITELOG)
@echo "TEST $< $(call get_coq_prog_args_in_parens,"$<")"
$(HIDE){ \
echo $(call log_intro,$<); \
- tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`; \
+ output=$*.out.real; \
$(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1 \
| grep -v "Welcome to Coq" \
| grep -v "\[Loading ML file" \
| grep -v "Skipping rcfile loading" \
| grep -v "^<W>" \
| sed 's/File "[^"]*"/File "stdin"/' \
- > $$tmpoutput; \
- diff -u --strip-trailing-cr $*.out $$tmpoutput 2>&1; R=$$?; times; \
+ > $$output; \
+ diff -u --strip-trailing-cr $*.out $$output 2>&1; R=$$?; times; \
if [ $$R = 0 ]; then \
echo $(log_success); \
echo " $<...Ok"; \
+ rm $$output; \
else \
echo $(log_failure); \
echo " $<...Error! (unexpected output)"; \
$(FAIL); \
fi; \
- rm $$tmpoutput; \
} > "$@"
+.PHONY: approve-output
+approve-output: output
+ $(HIDE)for f in output/*.out.real; do \
+ mv "$$f" "$${f%.real}"; \
+ echo "Updated $${f%.real}!"; \
+ done
+
# the expected output for the MExtraction test is
# /plugins/micromega/micromega.ml except with additional newline
output/MExtraction.out: ../plugins/micromega/micromega.ml
diff --git a/test-suite/README.md b/test-suite/README.md
index 4572c98cfe..ef2e574ece 100644
--- a/test-suite/README.md
+++ b/test-suite/README.md
@@ -76,3 +76,17 @@ There are also output tests in `test-suite/output` which consist of a `.v` file
There are unit tests of OCaml code in `test-suite/unit-tests`. These tests are contained in `.ml` files, and rely on the `OUnit`
unit-test framework, as described at http://ounit.forge.ocamlcore.org/. Use `make unit-tests' in the unit-tests directory to run them.
+
+## Fixing output tests
+
+When an output test `output/foo.v` fails, the output is stored in
+`output/foo.out.real`. Move that file to the reference file
+`output/foo.out` to update the test, approving the new output. Target
+`approve-output` will do this for all failing output tests
+automatically.
+
+Don't forget to check the updated `.out` files into git!
+
+Note that `output/MExtraction.out` is special: it is copied from
+`micromega/micromega.ml` in the plugin source directory. Automatic
+approval will incorrectly update the copy.
diff --git a/test-suite/bugs/7333.v b/test-suite/bugs/7333.v
new file mode 100644
index 0000000000..fba5b9029d
--- /dev/null
+++ b/test-suite/bugs/7333.v
@@ -0,0 +1,39 @@
+Module Example1.
+
+CoInductive wrap : Type :=
+ | item : unit -> wrap.
+
+Definition extract (t : wrap) : unit :=
+match t with
+| item x => x
+end.
+
+CoFixpoint close u : unit -> wrap :=
+match u with
+| tt => item
+end.
+
+Definition table : wrap := close tt tt.
+
+Eval vm_compute in (extract table).
+Eval vm_compute in (extract table).
+
+End Example1.
+
+Module Example2.
+
+Set Primitive Projections.
+CoInductive wrap : Type :=
+ item { extract : unit }.
+
+CoFixpoint close u : unit -> wrap :=
+match u with
+| tt => item
+end.
+
+Definition table : wrap := close tt tt.
+
+Eval vm_compute in (extract table).
+Eval vm_compute in (extract table).
+
+End Example2.
diff --git a/test-suite/bugs/closed/4403.v b/test-suite/bugs/closed/4403.v
new file mode 100644
index 0000000000..a80f38fe2a
--- /dev/null
+++ b/test-suite/bugs/closed/4403.v
@@ -0,0 +1,3 @@
+(* -*- coq-prog-args: ("-type-in-type"); -*- *)
+
+Definition some_prop : Prop := Type.
diff --git a/test-suite/bugs/closed/4882.v b/test-suite/bugs/closed/4882.v
deleted file mode 100644
index 8c26af708b..0000000000
--- a/test-suite/bugs/closed/4882.v
+++ /dev/null
@@ -1,50 +0,0 @@
-
-Definition Foo {T}{a : T} : T := a.
-
-Module A.
-
- Declare Implicit Tactic eauto.
-
- Goal forall A (x : A), A.
- intros.
- apply Foo. (* Check defined evars are normalized *)
- (* Qed. *)
- Abort.
-
-End A.
-
-Module B.
-
- Definition Foo {T}{a : T} : T := a.
-
- Declare Implicit Tactic eassumption.
-
- Goal forall A (x : A), A.
- intros.
- apply Foo.
- (* Qed. *)
- Abort.
-
-End B.
-
-Module C.
-
- Declare Implicit Tactic first [exact True|assumption].
-
- Goal forall (x : True), True.
- intros.
- apply (@Foo _ _).
- Qed.
-
-End C.
-
-Module D.
-
- Declare Implicit Tactic assumption.
-
- Goal forall A (x : A), A.
- intros.
- exact _.
- Qed.
-
-End D.
diff --git a/test-suite/bugs/closed/5539.v b/test-suite/bugs/closed/5539.v
new file mode 100644
index 0000000000..48e5568e9b
--- /dev/null
+++ b/test-suite/bugs/closed/5539.v
@@ -0,0 +1,15 @@
+Set Universe Polymorphism.
+
+Inductive D : nat -> Type :=
+| DO : D O
+| DS n : D n -> D (S n).
+
+Fixpoint follow (n : nat) : D n -> Prop :=
+ match n with
+ | O => fun d => let 'DO := d in True
+ | S n' => fun d => (let 'DS _ d' := d in fun f => f d') (follow n')
+ end.
+
+Definition step (n : nat) (d : D n) (H : follow n d) :
+ follow (S n) (DS n d)
+ := H.
diff --git a/test-suite/bugs/closed/6770.v b/test-suite/bugs/closed/6770.v
new file mode 100644
index 0000000000..9bcc740830
--- /dev/null
+++ b/test-suite/bugs/closed/6770.v
@@ -0,0 +1,7 @@
+Section visibility.
+
+ Let Fixpoint by_proof (n:nat) : True.
+ Proof. exact I. Defined.
+End visibility.
+
+Fail Check by_proof.
diff --git a/test-suite/bugs/closed/6951.v b/test-suite/bugs/closed/6951.v
new file mode 100644
index 0000000000..419f8d7c4e
--- /dev/null
+++ b/test-suite/bugs/closed/6951.v
@@ -0,0 +1,2 @@
+Record float2 : Set := Float2 { Fnum : unit }.
+Scheme Equality for float2.
diff --git a/test-suite/bugs/closed/7011.v b/test-suite/bugs/closed/7011.v
new file mode 100644
index 0000000000..296e4e11e5
--- /dev/null
+++ b/test-suite/bugs/closed/7011.v
@@ -0,0 +1,16 @@
+(* Fix and Cofix were missing in tactic unification *)
+
+Goal exists e, (fix foo (n : nat) : nat := match n with O => e | S n' => foo n' end)
+ = (fix foo (n : nat) : nat := match n with O => O | S n' => foo n' end).
+Proof.
+ eexists.
+ reflexivity.
+Qed.
+
+CoInductive stream := cons : nat -> stream -> stream.
+
+Goal exists e, (cofix foo := cons e foo) = (cofix foo := cons 0 foo).
+Proof.
+ eexists.
+ reflexivity.
+Qed.
diff --git a/test-suite/bugs/closed/7068.v b/test-suite/bugs/closed/7068.v
new file mode 100644
index 0000000000..9fadb195bf
--- /dev/null
+++ b/test-suite/bugs/closed/7068.v
@@ -0,0 +1,6 @@
+(* These tests are only about a subset of #7068 *)
+(* The original issue is still open *)
+
+Inductive foo : let T := Type in T := .
+Definition bob1 := Eval vm_compute in foo_rect.
+Definition bob2 := Eval native_compute in foo_rect.
diff --git a/test-suite/bugs/closed/7076.v b/test-suite/bugs/closed/7076.v
new file mode 100644
index 0000000000..0abc88c282
--- /dev/null
+++ b/test-suite/bugs/closed/7076.v
@@ -0,0 +1,4 @@
+(* These calls were raising an anomaly at some time *)
+Inductive A : nat -> id (nat->Type) := .
+Eval vm_compute in fun x => match x in A y z return y = z with end.
+Eval native_compute in fun x => match x in A y z return y = z with end.
diff --git a/test-suite/bugs/closed/7113.v b/test-suite/bugs/closed/7113.v
new file mode 100644
index 0000000000..976e60f20c
--- /dev/null
+++ b/test-suite/bugs/closed/7113.v
@@ -0,0 +1,10 @@
+Require Import Program.Tactics.
+Section visibility.
+
+ (* used to anomaly *)
+ Program Let Fixpoint ev' (n : nat) : bool := _.
+ Next Obligation. exact true. Qed.
+
+ Check ev'.
+End visibility.
+Fail Check ev'.
diff --git a/test-suite/bugs/closed/7195.v b/test-suite/bugs/closed/7195.v
new file mode 100644
index 0000000000..ea97747ac9
--- /dev/null
+++ b/test-suite/bugs/closed/7195.v
@@ -0,0 +1,12 @@
+(* A disjoint-names condition was missing when matching names in Ltac
+ pattern-matching *)
+
+Goal True.
+ let x := (eval cbv beta zeta in (fun P => let Q := P in fun P => P + Q)) in
+ unify x (fun a b => b + a); (* success *)
+ let x' := lazymatch x with
+ | (fun (a : ?A) (b : ?B) => ?k)
+ => constr:(fun (a : A) (b : B) => k)
+ end in
+ unify x x'.
+Abort.
diff --git a/test-suite/bugs/closed/7392.v b/test-suite/bugs/closed/7392.v
new file mode 100644
index 0000000000..cf465c6588
--- /dev/null
+++ b/test-suite/bugs/closed/7392.v
@@ -0,0 +1,9 @@
+Inductive R : nat -> Prop := ER : forall n, R n -> R (S n).
+
+Goal (forall (n : nat), R n -> False) -> True -> False.
+Proof.
+intros H0 H1.
+eapply H0.
+clear H1.
+apply ER.
+simpl.
diff --git a/test-suite/bugs/closed/7631.v b/test-suite/bugs/closed/7631.v
new file mode 100644
index 0000000000..34eb8b8676
--- /dev/null
+++ b/test-suite/bugs/closed/7631.v
@@ -0,0 +1,21 @@
+Module NamedContext.
+
+Definition foo := true.
+
+Section Foo.
+
+Let bar := foo.
+
+Eval native_compute in bar.
+
+End Foo.
+
+End NamedContext.
+
+Module RelContext.
+
+Definition foo := true.
+
+Definition bar (x := foo) := Eval native_compute in x.
+
+End RelContext.
diff --git a/test-suite/coqchk/bug_7539.v b/test-suite/coqchk/bug_7539.v
new file mode 100644
index 0000000000..74ebe9290d
--- /dev/null
+++ b/test-suite/coqchk/bug_7539.v
@@ -0,0 +1,26 @@
+Set Primitive Projections.
+
+CoInductive Stream : Type := Cons { tl : Stream }.
+
+Fixpoint Str_nth_tl (n:nat) (s:Stream) : Stream :=
+ match n with
+ | O => s
+ | S m => Str_nth_tl m (tl s)
+ end.
+
+CoInductive EqSt (s1 s2: Stream) : Prop := eqst {
+ eqst_tl : EqSt (tl s1) (tl s2);
+}.
+
+Axiom EqSt_reflex : forall (s : Stream), EqSt s s.
+
+CoFixpoint map (s:Stream) : Stream := Cons (map (tl s)).
+
+Lemma Str_nth_tl_map : forall n s, EqSt (Str_nth_tl n (map s)) (map (Str_nth_tl n s)).
+Proof.
+induction n.
++ intros; apply EqSt_reflex.
++ cbn; intros s; apply IHn.
+Qed.
+
+Definition boom : forall s, tl (map s) = map (tl s) := fun s => eq_refl.
diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out
index e73312c679..c0b04eb53f 100644
--- a/test-suite/output/Arguments_renaming.out
+++ b/test-suite/output/Arguments_renaming.out
@@ -1,6 +1,5 @@
The command has indeed failed with message:
-To rename arguments the "rename" flag must be specified.
-Argument A renamed to B.
+Flag "rename" expected to rename A into B.
File "stdin", line 2, characters 0-25:
Warning: This command is just asserting the names of arguments of identity.
If this is what you want add ': assert' to silence the warning. If you want
@@ -113,5 +112,4 @@ Argument z cannot be declared implicit.
The command has indeed failed with message:
Extra arguments: y.
The command has indeed failed with message:
-To rename arguments the "rename" flag must be specified.
-Argument A renamed to R.
+Flag "rename" expected to rename A into R.
diff --git a/test-suite/success/Fixpoint.v b/test-suite/success/Fixpoint.v
index 5fc703cf0f..efb32ef6f7 100644
--- a/test-suite/success/Fixpoint.v
+++ b/test-suite/success/Fixpoint.v
@@ -91,3 +91,33 @@ apply Cons2.
exact b.
apply (ex1 (S n) (negb b)).
Defined.
+
+Section visibility.
+
+ Let Fixpoint imm (n:nat) : True := I.
+
+ Let Fixpoint by_proof (n:nat) : True.
+ Proof. exact I. Defined.
+End visibility.
+
+Fail Check imm.
+Fail Check by_proof.
+
+Module Import mod_local.
+ Fixpoint imm_importable (n:nat) : True := I.
+
+ Local Fixpoint imm_local (n:nat) : True := I.
+
+ Fixpoint by_proof_importable (n:nat) : True.
+ Proof. exact I. Defined.
+
+ Local Fixpoint by_proof_local (n:nat) : True.
+ Proof. exact I. Defined.
+End mod_local.
+
+Check imm_importable.
+Fail Check imm_local.
+Check mod_local.imm_local.
+Check by_proof_importable.
+Fail Check by_proof_local.
+Check mod_local.by_proof_local.
diff --git a/test-suite/success/ImplicitTactic.v b/test-suite/success/ImplicitTactic.v
deleted file mode 100644
index d8fa3043de..0000000000
--- a/test-suite/success/ImplicitTactic.v
+++ /dev/null
@@ -1,16 +0,0 @@
-(* A Wiedijk-Cruz-Filipe style tactic for solving implicit arguments *)
-
-(* Declare a term expression with a hole *)
-Parameter quo : nat -> forall n:nat, n<>0 -> nat.
-Notation "x / y" := (quo x y _) : nat_scope.
-
-(* Declare the tactic for resolving implicit arguments still
- unresolved after type-checking; it must complete the subgoal to
- succeed *)
-Declare Implicit Tactic assumption.
-
-Goal forall n d, d<>0 -> { q:nat & { r:nat | d * q + r = n }}.
-intros.
-(* Here, assumption is used to solve the implicit argument of quo *)
-exists (n / d).
-
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-29 12:49:59 +0000