diff options
Diffstat (limited to 'test-suite')
| -rw-r--r-- | test-suite/ltac2/compat.v | 61 | ||||
| -rw-r--r-- | test-suite/output/Cases.out | 52 | ||||
| -rw-r--r-- | test-suite/output/Cases.v | 30 | ||||
| -rw-r--r-- | test-suite/output/Int63Syntax.out | 22 | ||||
| -rw-r--r-- | test-suite/output/Int63Syntax.v | 16 | ||||
| -rw-r--r-- | test-suite/output/RecordFieldErrors.out | 2 | ||||
| -rw-r--r-- | test-suite/output/RecordFieldErrors.v | 2 | ||||
| -rw-r--r-- | test-suite/output/UnivBinders.out | 3 | ||||
| -rw-r--r-- | test-suite/output/UnivBinders.v | 10 | ||||
| -rw-r--r-- | test-suite/output/bug_12908.v | 2 | ||||
| -rw-r--r-- | test-suite/output/bug_13595.out | 4 | ||||
| -rw-r--r-- | test-suite/output/bug_13595.v | 8 | ||||
| -rw-r--r-- | test-suite/primitive/uint63/addcarryc.v | 2 | ||||
| -rw-r--r-- | test-suite/primitive/uint63/addmuldiv.v | 2 | ||||
| -rw-r--r-- | test-suite/primitive/uint63/diveucl.v | 2 | ||||
| -rw-r--r-- | test-suite/primitive/uint63/head0.v | 2 | ||||
| -rw-r--r-- | test-suite/primitive/uint63/subcarryc.v | 2 | ||||
| -rw-r--r-- | test-suite/primitive/uint63/tail0.v | 2 | ||||
| -rw-r--r-- | test-suite/success/Case22.v | 13 | ||||
| -rw-r--r-- | test-suite/success/Cases.v | 57 | ||||
| -rw-r--r-- | test-suite/success/cbv_let.v | 34 |
21 files changed, 301 insertions, 27 deletions
diff --git a/test-suite/ltac2/compat.v b/test-suite/ltac2/compat.v index 9c11d19c27..b50371386f 100644 --- a/test-suite/ltac2/compat.v +++ b/test-suite/ltac2/compat.v @@ -40,6 +40,67 @@ Fail Ltac1.run (ltac1val:(x |- idtac) 0). Ltac1.run (ltac1val:(x |- idtac x) (Ltac1.of_constr constr:(Type))). Abort. +(** Check value-returning FFI *) + +(* A dummy CPS wrapper in Ltac1 *) +Ltac arg k := +match goal with +| [ |- ?P ] => k P +end. + +Ltac2 testeval v := + let r := { contents := None } in + let k c := + let () := match Ltac1.to_constr c with + | None => () + | Some c => r.(contents) := Some c + end in + (* dummy return value *) + ltac1val:(idtac) + in + let tac := ltac1val:(arg) in + let () := Ltac1.apply tac [Ltac1.lambda k] (fun _ => ()) in + match r.(contents) with + | None => fail + | Some c => if Constr.equal v c then () else fail + end. + +Goal True. +Proof. +testeval 'True. +Abort. + +Goal nat. +Proof. +testeval 'nat. +Abort. + +(* CPS towers *) +Ltac2 testeval2 tac := + let fail _ := Control.zero Not_found in + let cast c := match Ltac1.to_constr c with + | None => fail () + | Some c => c + end in + let f x y z := + let x := cast x in + let y := cast y in + let z := cast z in + Ltac1.of_constr constr:($x $y $z) + in + let f := Ltac1.lambda (fun x => Ltac1.lambda (fun y => Ltac1.lambda (fun z => f x y z))) in + Ltac1.apply tac [f] Ltac1.run. + +Goal False -> True. +Proof. +ltac1:( +let ff := ltac2:(tac |- testeval2 tac) in +ff ltac:(fun k => + let c := k (fun (n : nat) (i : True) (e : False) => i) O I in + exact c) +). +Qed. + (** Test calls to Ltac2 from Ltac1 *) Set Default Proof Mode "Classic". diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out index 01564e7f25..984ac4e527 100644 --- a/test-suite/output/Cases.out +++ b/test-suite/output/Cases.out @@ -74,7 +74,9 @@ fun '{{n, m, p}} => n + m + p fun '(D n m p q) => n + m + p + q : J -> nat The command has indeed failed with message: -The constructor D (in type J) expects 3 arguments. +Once notations are expanded, the resulting constructor D (in type J) is +expected to be applied to no arguments while it is actually applied to +1 argument. lem1 = fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl : forall k : nat * nat, k = k @@ -181,3 +183,51 @@ end File "stdin", line 253, characters 4-5: Warning: Unused variable B catches more than one case. [unused-pattern-matching-variable,pattern-matching] +The command has indeed failed with message: +Application of arguments to a recursive notation not supported in patterns. +The command has indeed failed with message: +The constructor cons (in type list) is expected to be applied to 2 arguments +while it is actually applied to 3 arguments. +The command has indeed failed with message: +The constructor cons (in type list) is expected to be applied to 2 arguments +while it is actually applied to 1 argument. +The command has indeed failed with message: +The constructor D' (in type J') is expected to be applied to 4 arguments (or +6 arguments when including variables for local definitions) while it is +actually applied to 5 arguments. +fun x : J' bool (true, true) => +match x with +| D' _ _ _ m _ e => existT (fun x0 : nat => x0 = x0) m e +end + : J' bool (true, true) -> {x0 : nat & x0 = x0} +fun x : J' bool (true, true) => +match x with +| @D' _ _ _ _ n _ p _ => n + p +end + : J' bool (true, true) -> nat +The command has indeed failed with message: +Application of arguments to a recursive notation not supported in patterns. +The command has indeed failed with message: +The constructor cons (in type list) is expected to be applied to 2 arguments +while it is actually applied to 3 arguments. +The command has indeed failed with message: +The constructor cons (in type list) is expected to be applied to 2 arguments +while it is actually applied to 1 argument. +The command has indeed failed with message: +The constructor D' (in type J') is expected to be applied to 3 arguments (or +4 arguments when including variables for local definitions) while it is +actually applied to 2 arguments. +The command has indeed failed with message: +The constructor D' (in type J') is expected to be applied to 3 arguments (or +4 arguments when including variables for local definitions) while it is +actually applied to 5 arguments. +fun x : J' bool (true, true) => +match x with +| @D' _ _ _ _ _ m _ e => existT (fun x0 : nat => x0 = x0) m e +end + : J' bool (true, true) -> {x0 : nat & x0 = x0} +fun x : J' bool (true, true) => +match x with +| @D' _ _ _ _ n _ p _ => (n, p) +end + : J' bool (true, true) -> nat * nat diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v index 2d8a8b359c..0cb3ac3ddc 100644 --- a/test-suite/output/Cases.v +++ b/test-suite/output/Cases.v @@ -254,3 +254,33 @@ Definition bar (f : foo) := end. End Wish12762. + +Module ConstructorArgumentsNumber. + +Arguments cons {A} _ _. + +Inductive J' A {B} (C:=(A*B)%type) (c:C) := D' : forall n {m}, let p := n+m in m=m -> J' A c. + +Unset Asymmetric Patterns. + +Fail Check fun x => match x with (y,z) w => y+z+w end. +Fail Check fun x => match x with cons y z w => 0 | nil => 0 end. +Fail Check fun x => match x with cons y => 0 | nil => 0 end. + +(* Missing a let-in to be in let-in mode *) +Fail Check fun x => match x with D' _ _ n p e => 0 end. +Check fun x : J' bool (true,true) => match x with D' _ _ n e => existT (fun x => eq x x) _ e end. +Check fun x : J' bool (true,true) => match x with D' _ _ _ n p e => n+p end. + +Set Asymmetric Patterns. + +Fail Check fun x => match x with (y,z) w => y+z+w end. +Fail Check fun x => match x with cons y z w => 0 | nil => 0 end. +Fail Check fun x => match x with cons y => 0 | nil => 0 end. + +Fail Check fun x => match x with D' n _ => 0 end. +Fail Check fun x => match x with D' n m p e _ => 0 end. +Check fun x : J' bool (true,true) => match x with D' n m e => existT (fun x => eq x x) m e end. +Check fun x : J' bool (true,true) => match x with D' n m p e => (n,p) end. + +End ConstructorArgumentsNumber. diff --git a/test-suite/output/Int63Syntax.out b/test-suite/output/Int63Syntax.out index eefa338f0d..ca8e1b58a8 100644 --- a/test-suite/output/Int63Syntax.out +++ b/test-suite/output/Int63Syntax.out @@ -1,7 +1,5 @@ 2%int63 : int -(2 + 2)%int63 - : int 2 : int 9223372036854775807 @@ -17,9 +15,9 @@ 427 : int The command has indeed failed with message: -Cannot interpret this number as a value of type Coq.Numbers.Cyclic.Int63.Int63.int +Cannot interpret this number as a value of type Coq.Numbers.Cyclic.Int63.PrimInt63.int The command has indeed failed with message: -Cannot interpret this number as a value of type Coq.Numbers.Cyclic.Int63.Int63.int +Cannot interpret this number as a value of type Coq.Numbers.Cyclic.Int63.PrimInt63.int 0 : int 0 @@ -32,13 +30,7 @@ The command has indeed failed with message: The reference x1 was not found in the current environment. The command has indeed failed with message: The reference x was not found in the current environment. -2 + 2 - : int -2 + 2 - : int - = 4 - : int - = 37151199385380486 +add 2 2 : int The command has indeed failed with message: int63 are only non-negative numbers. @@ -56,3 +48,11 @@ t = 2%i63 : nat 2 : int +(2 + 2)%int63 + : int +2 + 2 + : int + = 4 + : int + = 37151199385380486 + : int diff --git a/test-suite/output/Int63Syntax.v b/test-suite/output/Int63Syntax.v index c49616d918..6f1046f7a5 100644 --- a/test-suite/output/Int63Syntax.v +++ b/test-suite/output/Int63Syntax.v @@ -1,7 +1,6 @@ -Require Import Int63 Cyclic63. +Require Import PrimInt63. Check 2%int63. -Check (2 + 2)%int63. Open Scope int63_scope. Check 2. Check 9223372036854775807. @@ -18,10 +17,7 @@ Fail Check 0xg. Fail Check 0xG. Fail Check 00x1. Fail Check 0x. -Check (Int63.add 2 2). -Check (2+2). -Eval vm_compute in 2+2. -Eval vm_compute in 65675757 * 565675998. +Check (PrimInt63.add 2 2). Fail Check -1. Fail Check 9223372036854775808. Open Scope nat_scope. @@ -36,3 +32,11 @@ Check 2. Close Scope nat_scope. Check 2. Close Scope int63_scope. + +Require Import Int63. + +Check (2 + 2)%int63. +Open Scope int63_scope. +Check (2+2). +Eval vm_compute in 2+2. +Eval vm_compute in 65675757 * 565675998. diff --git a/test-suite/output/RecordFieldErrors.out b/test-suite/output/RecordFieldErrors.out index 5b67f632c9..b80345108e 100644 --- a/test-suite/output/RecordFieldErrors.out +++ b/test-suite/output/RecordFieldErrors.out @@ -11,4 +11,4 @@ This record defines several times the field foo. The command has indeed failed with message: This record defines several times the field unit. The command has indeed failed with message: -unit: Not a projection of inductive t. +unit: Not a projection. diff --git a/test-suite/output/RecordFieldErrors.v b/test-suite/output/RecordFieldErrors.v index 27aa07822b..ff817c31aa 100644 --- a/test-suite/output/RecordFieldErrors.v +++ b/test-suite/output/RecordFieldErrors.v @@ -35,4 +35,4 @@ acceptable and seems an unlikely mistake. *) Fail Check {| foo := tt; unit := tt |}. -(* unit: Not a projection of inductive t. *) +(* unit: Not a projection. *) diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out index 0fbb4f4c11..95b6c6ee95 100644 --- a/test-suite/output/UnivBinders.out +++ b/test-suite/output/UnivBinders.out @@ -162,6 +162,9 @@ When declaring multiple axioms in one command, only the first is allowed a unive foo@{i} = Type@{M.i} -> Type@{i} : Type@{max(M.i+1,i+1)} (* i |= *) +Type@{u0} -> Type@{UnivBinders.64} + : Type@{max(u0+1,UnivBinders.64+1)} +(* {UnivBinders.64} |= *) bind_univs.mono = Type@{bind_univs.mono.u} : Type@{bind_univs.mono.u+1} diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v index ed6e90b2a6..9539e34cfe 100644 --- a/test-suite/output/UnivBinders.v +++ b/test-suite/output/UnivBinders.v @@ -161,6 +161,16 @@ Module Notas. End Notas. +Module NoAutoNames. + Monomorphic Universe u0. + + (* The anonymous universe doesn't get a name (names are only + invented at the end of a definition/inductive) so no need to + qualify u0. *) + Check (Type@{u0} -> Type). + +End NoAutoNames. + (* Universe binders survive through compilation, sections and modules. *) Require TestSuite.bind_univs. Print bind_univs.mono. diff --git a/test-suite/output/bug_12908.v b/test-suite/output/bug_12908.v index 6f7be22fa0..7ab218a27a 100644 --- a/test-suite/output/bug_12908.v +++ b/test-suite/output/bug_12908.v @@ -7,7 +7,7 @@ Check forall m n, mult' m n = Nat.mul (Nat.mul 2 m) n. End A. Module B. -(* Test that an overriden scoped notation is deactivated *) +(* Test that an overridden scoped notation is deactivated *) Infix "*" := mult' : nat_scope. Check forall m n, mult' m n = Nat.mul (Nat.mul 2 m) n. End B. diff --git a/test-suite/output/bug_13595.out b/test-suite/output/bug_13595.out new file mode 100644 index 0000000000..2423b77b55 --- /dev/null +++ b/test-suite/output/bug_13595.out @@ -0,0 +1,4 @@ +The command has indeed failed with message: +Tactic failure: Goal is solvable by congruence but some arguments are missing. + Try "congruence with ((Triple a _ _)) ((Triple d c _))", + replacing metavariables by arbitrary terms. diff --git a/test-suite/output/bug_13595.v b/test-suite/output/bug_13595.v new file mode 100644 index 0000000000..27a9ebe15d --- /dev/null +++ b/test-suite/output/bug_13595.v @@ -0,0 +1,8 @@ +Inductive Cube:Set :=| Triple: nat -> nat -> nat -> Cube. + +Theorem incomplete :forall a b c d : nat,Triple a = Triple b->Triple d c = Triple d b->a = c. +Proof. + Fail congruence. + intros. + congruence with ((Triple a a a)) ((Triple d c a)). +Qed. diff --git a/test-suite/primitive/uint63/addcarryc.v b/test-suite/primitive/uint63/addcarryc.v index a4430769ca..7ab3af51d8 100644 --- a/test-suite/primitive/uint63/addcarryc.v +++ b/test-suite/primitive/uint63/addcarryc.v @@ -1,4 +1,4 @@ -Require Import Int63. +Require Import PrimInt63. Set Implicit Arguments. diff --git a/test-suite/primitive/uint63/addmuldiv.v b/test-suite/primitive/uint63/addmuldiv.v index 72b0164b49..e3aded6c96 100644 --- a/test-suite/primitive/uint63/addmuldiv.v +++ b/test-suite/primitive/uint63/addmuldiv.v @@ -1,4 +1,4 @@ -Require Import Int63. +Require Import PrimInt63. Set Implicit Arguments. diff --git a/test-suite/primitive/uint63/diveucl.v b/test-suite/primitive/uint63/diveucl.v index 8f88a0f356..43a0741ffe 100644 --- a/test-suite/primitive/uint63/diveucl.v +++ b/test-suite/primitive/uint63/diveucl.v @@ -1,4 +1,4 @@ -Require Import Int63. +Require Import PrimInt63. Set Implicit Arguments. diff --git a/test-suite/primitive/uint63/head0.v b/test-suite/primitive/uint63/head0.v index f4234d2605..30cbce4537 100644 --- a/test-suite/primitive/uint63/head0.v +++ b/test-suite/primitive/uint63/head0.v @@ -1,4 +1,4 @@ -Require Import Int63. +Require Import PrimInt63. Set Implicit Arguments. diff --git a/test-suite/primitive/uint63/subcarryc.v b/test-suite/primitive/uint63/subcarryc.v index e81b6536b2..6a773dde5d 100644 --- a/test-suite/primitive/uint63/subcarryc.v +++ b/test-suite/primitive/uint63/subcarryc.v @@ -1,4 +1,4 @@ -Require Import Int63. +Require Import PrimInt63. Set Implicit Arguments. diff --git a/test-suite/primitive/uint63/tail0.v b/test-suite/primitive/uint63/tail0.v index c9d426087a..1f91e4106c 100644 --- a/test-suite/primitive/uint63/tail0.v +++ b/test-suite/primitive/uint63/tail0.v @@ -1,4 +1,4 @@ -Require Import Int63. +Require Import PrimInt63. Set Implicit Arguments. diff --git a/test-suite/success/Case22.v b/test-suite/success/Case22.v index 465b3eb8c0..90c1b308f2 100644 --- a/test-suite/success/Case22.v +++ b/test-suite/success/Case22.v @@ -89,3 +89,16 @@ Check fun x:Ind bool nat => match x in Ind _ X Y Z return Z with | y => (true,0) end. + +(* A check that multi-implicit arguments work *) + +Check fun x : {True}+{False} => match x with left _ _ => 0 | right _ _ => 1 end. +Check fun x : {True}+{False} => match x with left _ => 0 | right _ => 1 end. + +(* Check that Asymmetric Patterns does not apply to the in clause *) + +Inductive expr {A} : A -> Type := intro : forall {n:nat} (a:A), n=n -> expr a. +Check fun (x:expr true) => match x in expr n return n=n with intro _ _ => eq_refl end. +Set Asymmetric Patterns. +Check fun (x:expr true) => match x in expr n return n=n with intro _ a _ => eq_refl a end. +Unset Asymmetric Patterns. diff --git a/test-suite/success/Cases.v b/test-suite/success/Cases.v index 232ac17cbf..e678fc7882 100644 --- a/test-suite/success/Cases.v +++ b/test-suite/success/Cases.v @@ -1882,3 +1882,60 @@ Check match O in nat return nat with O => O | _ => O end. (* Checking that aliases are substituted in the correct order *) Check match eq_refl (1,0) in _ = (y as z, y' as z) return z = z with eq_refl => eq_refl end : 0=0. + +(* Checking use of argument scopes *) + +Module Intern. + +Inductive I (A:Type) := C : nat -> let a:=0 in bool -> list bool -> bool -> I A. + +Close Scope nat_scope. +Notation "0" := true : bool_scope. +Notation "0" := nil : list_scope. +Notation C' := @C (only parsing). +Notation C'' := C (only parsing). +Notation C''' := (C _ 0) (only parsing). + +Set Asymmetric Patterns. + +Check fun x => match x with C 0 0 0 0 => O | _ => O end. (* 8.5 regression *) +Check fun x => match x with C 0 _ 0 0 0 => O | _ => O end. (* was not supported *) + +Check fun x => match x with C' 0 0 0 0 => O | _ => O end. (* 8.5 regression *) +Check fun x => match x with C' _ 0 0 0 => O | _ => O end. (* 8.5 regression *) +Check fun x => match x with C' 0 _ 0 0 0 => O | _ => O end. (* was not supported *) +Check fun x => match x with C' _ _ 0 0 0 => O | _ => O end. (* was pre 8.5 bug *) + +Check fun x => match x with C'' 0 0 0 0 => O | _ => O end. (* 8.5 regression *) +Check fun x => match x with C'' _ 0 0 0 => O | _ => O end. (* 8.5 regression *) +Check fun x => match x with C'' 0 _ 0 0 0 => O | _ => O end. (* was not supported *) +Check fun x => match x with C'' _ _ 0 0 0 => O | _ => O end. (* was pre 8.5 bug *) + +Check fun x => match x with C''' 0 0 0 => O | _ => O end. (* 8.5 regression *) +Check fun x => match x with C''' _ 0 0 0 => O | _ => O end. (* was not supported *) + +Unset Asymmetric Patterns. +Arguments C {A} _ {x} _ _. + +Check fun x => match x with C 0 0 0 => O | _ => O end. (* was ok *) +Check fun x => match x with C 0 _ 0 0 => O | _ => O end. (* was wrong scope on last argument with let-in *) + +Check fun x => match x with C' _ 0 _ 0 0 => O | _ => O end. (* was wrong scope *) +Check fun x => match x with C' _ 0 _ 0 0 0 => O | _ => O end. (* was wrong scope *) + +Check fun x => match x with C'' _ 0 0 => O | _ => O end. (* was ok *) +Check fun x => match x with C'' _ _ 0 0 => O | _ => O end. (* was wrong scope *) + +Check fun x => match x with C''' 0 0 => O | _ => O end. (* was wrong scope *) +Check fun x => match x with C''' _ 0 0 => O | _ => O end. (* works by miscount compensating *) + +Check fun x => match x with (@C _ 0) _ 0 0 => O | _ => O end. (* was wrong scope *) +Check fun x => match x with (@C _ 0) _ _ 0 0 => O | _ => O end. (* was wrong scope *) + +Check fun x => match x with @C _ 0 _ 0 0 => O | _ => O end. (* was ok *) +Check fun x => match x with @C _ 0 _ _ 0 0 => O | _ => O end. (* was wrong scope *) + +Check fun x => match x with (@C) _ O _ 0 0 => O | _ => O end. (* was wrong scope *) +Check fun x => match x with (@C) _ O _ _ 0 0 => O | _ => O end. (* was wrong scope *) + +End Intern. diff --git a/test-suite/success/cbv_let.v b/test-suite/success/cbv_let.v new file mode 100644 index 0000000000..861a73a64e --- /dev/null +++ b/test-suite/success/cbv_let.v @@ -0,0 +1,34 @@ +Record T : Type := Build_T { f : unit; g := pair f f; }. + +Definition t : T := {| f := tt; |}. + +Goal match t return unit with Build_T f g => f end = tt. +Proof. +cbv. +reflexivity. +Qed. + +Goal match t return prod unit unit with Build_T f g => g end = pair tt tt. +Proof. +cbv. +reflexivity. +Qed. + +Goal forall (x : T), + match x return prod unit unit with Build_T f g => g end = + pair match x return unit with Build_T f g => fst g end match x return unit with Build_T f g => snd g end. +Proof. +cbv. +destruct x. +reflexivity. +Qed. + +Record U : Type := Build_U { h := tt }. + +Definition u : U := Build_U. + +Goal match u with Build_U h => h end = tt. +Proof. +cbv. +reflexivity. +Qed. |
