Merge branch 'v8.5'

7 files changed, 304 insertions, 27 deletions

diff --git a/test-suite/bugs/closed/3974.v b/test-suite/bugs/closed/3974.v
new file mode 100644
index 0000000000..b6be159595
--- /dev/null
+++ b/test-suite/bugs/closed/3974.v
@@ -0,0 +1,7 @@
+Module Type S.
+End S.
+
+Module Type M (X : S).
+  Fail Module P (X : S).
+  (* Used to say: Anomaly: X already exists. Please report. *)
+  (* Should rather say now: Error: X already exists. *)
\ No newline at end of file
diff --git a/test-suite/bugs/closed/3975.v b/test-suite/bugs/closed/3975.v
new file mode 100644
index 0000000000..95851c8137
--- /dev/null
+++ b/test-suite/bugs/closed/3975.v
@@ -0,0 +1,8 @@
+Module Type S. End S.
+
+Module M (X:S). End M.
+
+Module Type P (X : S).
+  Print M.
+  (* Used to say: Anomaly: X already exists. Please report. *)
+  (* Should rather : print something :-) *)
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4375.v b/test-suite/bugs/closed/4375.v
new file mode 100644
index 0000000000..03af16535b
--- /dev/null
+++ b/test-suite/bugs/closed/4375.v
@@ -0,0 +1,106 @@
+
+
+Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+  t.
+
+
+Module A.
+Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+  match n with
+  | 0 => t
+  | S n => bar t n
+  end
+
+with bar (t : Type@{i}) (n : nat) : Type@{i} :=
+    match n with
+    | 0 => t
+    | S n => foo t n
+    end.
+End A.
+
+Module B.
+Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+  match n with
+  | 0 => t
+  | S n => bar t n
+  end
+
+with bar@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+    match n with
+    | 0 => t
+    | S n => foo t n
+    end.
+End B.
+
+Module C.
+Fail Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+  match n with
+  | 0 => t
+  | S n => bar t n
+  end
+
+with bar@{j} (t : Type@{j}) (n : nat) : Type@{j} :=
+    match n with
+    | 0 => t
+    | S n => foo t n
+    end.
+End C.
+
+Module D.
+Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} :=
+  match n with
+  | 0 => t
+  | S n => bar t n
+  end
+
+with bar@{i j} (t : Type@{j}) (n : nat) : Type@{j} :=
+    match n with
+    | 0 => t
+    | S n => foo t n
+    end.
+End D.
+
+Module E.
+Fail Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} :=
+  match n with
+  | 0 => t
+  | S n => bar t n
+  end
+
+with bar@{j i} (t : Type@{j}) (n : nat) : Type@{j} :=
+    match n with
+    | 0 => t
+    | S n => foo t n
+    end.
+End E.
+
+(*
+Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+  t.
+
+Print g.
+
+Polymorphic Fixpoint a@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+  t
+with b@{i} (t : Type@{i}) (n : nat) : Type@{i} :=
+  t.
+
+Print a.
+Print b.
+*)
+
+Polymorphic CoInductive foo@{i} (T : Type@{i}) : Type@{i} :=
+| A : foo T -> foo T.
+
+Polymorphic CoFixpoint cg@{i} (t : Type@{i}) : foo@{i} t :=
+  @A@{i} t (cg@{i} t).
+
+Print cg.
+
+Polymorphic CoFixpoint ca@{i} (t : Type@{i}) : foo@{i} t :=
+  @A@{i} t (@cb@{i} t)
+with cb@{i} (t : Type@{i}) : foo@{i} t :=
+  @A@{i} t (@ca@{i} t).
+
+Print ca.
+Print cb.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4390.v b/test-suite/bugs/closed/4390.v
new file mode 100644
index 0000000000..a96a137001
--- /dev/null
+++ b/test-suite/bugs/closed/4390.v
@@ -0,0 +1,37 @@
+Module A.
+Set Printing All.
+Set Printing Universes.
+
+Module M.
+Section foo.
+Universe i.
+End foo.
+End M.
+
+Check Type@{i}.
+(* Succeeds *)
+
+Fail Check Type@{j}.
+(* Error: Undeclared universe: j *)
+
+Definition foo@{j} : Type@{i} := Type@{j}.
+(* ok *)
+End A.
+
+Set Universe Polymorphism.
+Fail Universes j.
+Monomorphic Universe j.
+Section foo.
+  Universes i.
+  Constraint i < j.
+  Definition foo : Type@{j} := Type@{i}.
+  Definition foo' : Type@{j} := Type@{i}.
+End foo.
+
+Check eq_refl : foo@{i} = foo'@{i}.
+
+Definition bar := foo.
+Monomorphic Definition bar'@{k} := foo@{k}.
+
+Fail Constraint j = j.
+Monomorphic Constraint i = i.
diff --git a/test-suite/kernel/vm-univ.v b/test-suite/kernel/vm-univ.v
new file mode 100644
index 0000000000..1bdba3c68d
--- /dev/null
+++ b/test-suite/kernel/vm-univ.v
@@ -0,0 +1,145 @@
+(* Basic tests *)
+Polymorphic Definition pid {T : Type} (x : T) : T := x.
+(*
+Definition _1 : pid true = true :=
+  @eq_refl _ true <: pid true = true.
+
+Polymorphic Definition a_type := Type.
+
+Definition _2 : a_type@{i} = Type@{i} :=
+  @eq_refl _ Type@{i} <: a_type@{i} = Type@{i}.
+
+Polymorphic Definition FORALL (T : Type) (P : T -> Prop) : Prop :=
+  forall x : T, P x.
+
+Polymorphic Axiom todo : forall {T:Type}, T -> T.
+
+Polymorphic Definition todo' (T : Type) := @todo T.
+
+Definition _3 : @todo'@{Set} = @todo@{Set} :=
+  @eq_refl _ (@todo@{Set}) <: @todo'@{Set} = @todo@{Set}.
+*)
+
+(* Inductive Types *)
+Inductive sumbool (A B : Prop) : Set :=
+| left : A -> sumbool A B
+| right : B -> sumbool A B.
+
+Definition x : sumbool True False := left _ _ I.
+
+Definition sumbool_copy {A B : Prop} (H : sumbool A B) : sumbool A B :=
+  match H with
+  | left _ _ x => left _ _ x
+  | right _ _ x => right _ _ x
+  end.
+
+Definition _4 : sumbool_copy x = x :=
+  @eq_refl _ x <: sumbool_copy x = x.
+
+(* Polymorphic Inductive Types *)
+Polymorphic Inductive poption (T : Type@{i}) : Type@{i} :=
+| PSome : T -> poption@{i} T
+| PNone : poption@{i} T.
+
+Polymorphic Definition poption_default {T : Type@{i}} (p : poption@{i} T) (x : T) : T :=
+  match p with
+  | @PSome _ y => y
+  | @PNone _ => x
+  end.
+
+Polymorphic Inductive plist (T : Type@{i}) : Type@{i} :=
+| pnil
+| pcons : T -> plist@{i} T -> plist@{i} T.
+
+Arguments pnil {_}.
+Arguments pcons {_} _ _.
+
+Section pmap.
+  Context {T : Type@{i}} {U : Type@{j}} (f : T -> U).
+
+  Polymorphic Fixpoint pmap (ls : plist@{i} T) : plist@{j} U :=
+    match ls with
+    | @pnil _ => @pnil _
+    | @pcons _ l ls => @pcons@{j} U (f l) (pmap@{i j} ls)
+    end.
+End pmap.
+
+Universe Ubool.
+Inductive tbool : Type@{Ubool} := ttrue | tfalse.
+
+
+Eval vm_compute in pmap pid (pcons true (pcons false pnil)).
+Eval vm_compute in pmap (fun x => match x with
+                                  | pnil => true
+                                  | pcons _ _ => false
+                                  end) (pcons pnil (pcons (pcons false pnil) pnil)).
+Eval vm_compute in pmap (fun x => x -> Type) (pcons tbool (pcons (plist tbool) pnil)).
+
+Polymorphic Inductive Tree (T : Type@{i}) : Type@{i} :=
+| Empty
+| Branch : plist@{i} (Tree@{i} T) -> Tree@{i} T.
+
+Section pfold.
+  Context {T : Type@{i}} {U : Type@{u}} (f : T -> U -> U).
+
+  Polymorphic Fixpoint pfold (acc : U) (ls : plist@{i} T) : U :=
+    match ls with
+    | pnil => acc
+    | pcons a b => pfold (f a acc) b
+    end.
+End pfold.
+
+Polymorphic Inductive nat : Type@{i} :=
+| O
+| S : nat -> nat.
+
+Fixpoint nat_max (a b : nat) : nat :=
+  match a , b with
+  | O , b => b
+  | a , O => a
+  | S a , S b => S (nat_max a b)
+  end.
+
+Polymorphic Fixpoint height {T : Type@{i}} (t : Tree@{i} T) : nat :=
+  match t with
+  | Empty _ => O
+  | Branch _ ls => S (pfold nat_max O (pmap height ls))
+  end.
+
+Polymorphic Fixpoint repeat {T : Type@{i}} (n : nat) (v : T) : plist@{i} T :=
+  match n with
+  | O => pnil
+  | S n => pcons v (repeat n v)
+  end.
+
+Polymorphic Fixpoint big_tree (n : nat) : Tree@{i} nat :=
+  match n with
+  | O => @Empty nat
+  | S n' => Branch _ (repeat n' (big_tree n'))
+  end.
+
+Eval compute in height (big_tree (S (S (S O)))).
+
+Let big := S (S (S (S (S O)))).
+Polymorphic Definition really_big := (S@{i} (S (S (S (S (S (S (S (S (S O)))))))))).
+
+Time Definition _5 : height (@Empty nat) = O :=
+  @eq_refl nat O <: height (@Empty nat) = O.
+
+Time Definition _6 : height@{Set} (@Branch nat pnil) = S O :=
+  @eq_refl nat@{Set} (S@{Set} O@{Set}) <: height@{Set} (@Branch nat pnil) = S O.
+
+Time Definition _7 : height (big_tree big) = big :=
+  @eq_refl nat big <: height (big_tree big) = big.
+
+Time Definition _8 : height (big_tree really_big) = really_big :=
+ @eq_refl nat@{Set} (S@{Set}
+        (S@{Set}
+           (S@{Set}
+              (S@{Set}
+                 (S@{Set}
+                    (S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} O@{Set}))))))))))
+ <:
+ @eq nat@{Set}
+   (@height nat@{Set} (big_tree really_big@{Set}))
+   really_big@{Set}.
diff --git a/test-suite/success/ltac.v b/test-suite/success/ltac.v
index 5bef2e512a..6c4d4ae98f 100644
--- a/test-suite/success/ltac.v
+++ b/test-suite/success/ltac.v
@@ -317,29 +317,3 @@ let T := constr:(fun a b : nat => a) in
   end.
 exact (eq_refl n).
 Qed.
-
-(* Check that matching "match" does not look into the invisible
-   canonically generated binders of the return clause and of the branches *)
-
-Goal forall n, match n with 0 => true | S _ => false end = true.
-intros. unfold nat_rect.
-Fail match goal with |- context [nat] => idtac end.
-Abort.
-
-(* Check that branches of automatically generated elimination
-   principle are correctly eta-expanded and hence matchable as seen
-   from the user point of view *)
-
-Goal forall a f n, nat_rect (fun _ => nat) a f n = 0.
-intros. unfold nat_rect.
-match goal with |- context [f _] => idtac end.
-Abort.
-
-(* Check that branches of automatically generated elimination
-   principle are in correct form also in the presence of let-ins *)
-
-Inductive a (b:=0) : let b':=1 in Type := c : let d:=0 in a.
-Goal forall x, match x with c => 0 end = 1.
-intros.
-match goal with |- context [0] => idtac end.
-Abort.
diff --git a/test-suite/success/univnames.v b/test-suite/success/univnames.v
index 31d264f645..048b53d26c 100644
--- a/test-suite/success/univnames.v
+++ b/test-suite/success/univnames.v
@@ -21,6 +21,6 @@ Inductive bla@{l k} : Type@{k} := blaI : Type@{l} -> bla.
 Inductive blacopy@{k l} : Type@{k} := blacopyI : Type@{l} -> blacopy.
 
 
-Universe g.
+Monomorphic Universe g.
 
 Inductive blacopy'@{l} : Type@{g} := blacopy'I : Type@{l} -> blacopy'.
\ No newline at end of file