1 files changed, 147 insertions, 1 deletions

diff --git a/test-suite/success/polymorphism.v b/test-suite/success/polymorphism.v
index 878875bd..d76b3079 100644
--- a/test-suite/success/polymorphism.v
+++ b/test-suite/success/polymorphism.v
@@ -156,6 +156,58 @@ Polymorphic Definition twoprojs (d : dyn) := dyn_proof d = dyn_proof d.
 
 End structures.
 
+
+Module binders.
+
+  Definition mynat@{|} := nat.
+
+  Definition foo@{i j | i < j, i < j} (A : Type@{i}) : Type@{j}.
+    exact A.
+  Defined.
+
+  Definition nomoreu@{i j | i < j +} (A : Type@{i}) : Type@{j}.
+    pose(foo:=Type).
+    exact A.
+    Fail Defined.
+  Abort.
+
+  Polymorphic Definition moreu@{i j +} (A : Type@{i}) : Type@{j}.
+    pose(foo:=Type).
+    exact A.
+  Defined.
+
+  Check moreu@{_ _ _ _}.
+  
+  Fail Definition morec@{i j|} (A : Type@{i}) : Type@{j} := A.
+
+  (* By default constraints are extensible *)
+  Polymorphic Definition morec@{i j} (A : Type@{i}) : Type@{j} := A.
+  Check morec@{_ _}.
+
+  (* Handled in proofs as well *)
+  Lemma bar@{i j | } : Type@{i}.
+    exact Type@{j}.
+    Fail Defined.
+  Abort.
+
+  Fail Lemma bar@{u v | } : let x := (fun x => x) : Type@{u} -> Type@{v} in nat.
+
+  Lemma bar@{i j| i < j} : Type@{j}.
+  Proof.
+    exact Type@{i}.
+  Qed.
+
+  Lemma barext@{i j|+} : Type@{j}.
+  Proof.
+    exact Type@{i}.
+  Qed.
+
+  Monomorphic Universe M.
+  Fail Definition with_mono@{u|} : Type@{M} := Type@{u}.
+  Definition with_mono@{u|u < M} : Type@{M} := Type@{u}.
+
+End binders.
+    
 Section cats.
   Local Set Universe Polymorphism.
   Require Import Utf8.
@@ -321,4 +373,98 @@ Definition unwrap' := fun (X : Type) (b : box X) => let (unw) := b in unw.
 Fail Definition bad : False := TypeNeqSmallType.paradox (unwrap' Type (wrap _
 Type)) eq_refl.
 
-End Hurkens'.
\ No newline at end of file
+End Hurkens'.
+
+Module Anonymous.
+  Set Universe Polymorphism.
+
+  Definition defaultid := (fun x => x) : Type -> Type.
+  Definition collapseid := defaultid@{_ _}.
+  Check collapseid@{_}.
+
+  Definition anonid := (fun x => x) : Type -> Type@{_}.
+  Check anonid@{_}.
+
+  Definition defaultalg := (fun x : Type => x) (Type : Type).
+  Definition usedefaultalg := defaultalg@{_ _ _}.
+  Check usedefaultalg@{_ _}.
+
+  Definition anonalg := (fun x : Type@{_} => x) (Type : Type).
+  Check anonalg@{_ _}.
+
+  Definition unrelated@{i j} := nat.
+  Definition useunrelated := unrelated@{_ _}.
+  Check useunrelated@{_ _}.
+
+  Definition inthemiddle@{i j k} :=
+    let _ := defaultid@{i j} in
+    anonalg@{k j}.
+  (* i <= j < k *)
+  Definition collapsethemiddle := inthemiddle@{i _ j}.
+  Check collapsethemiddle@{_ _}.
+
+End Anonymous.
+
+Module Restrict.
+  (* Universes which don't appear in the term should be pruned, unless they have names *)
+  Set Universe Polymorphism.
+
+  Ltac exact0 := let x := constr:(Type) in exact 0.
+  Definition dummy_pruned@{} : nat := ltac:(exact0).
+
+  Definition named_not_pruned@{u} : nat := 0.
+  Check named_not_pruned@{_}.
+
+  Definition named_not_pruned_nonstrict : nat := ltac:(let x := constr:(Type@{u}) in exact 0).
+  Check named_not_pruned_nonstrict@{_}.
+
+  Lemma lemma_restrict_poly@{} : nat.
+  Proof. exact0. Defined.
+
+  Unset Universe Polymorphism.
+  Lemma lemma_restrict_mono_qed@{} : nat.
+  Proof. exact0. Qed.
+
+  Lemma lemma_restrict_abstract@{} : nat.
+  Proof. abstract exact0. Qed.
+
+End Restrict.
+
+Module F.
+  Context {A B : Type}.
+  Definition foo : Type := B.
+End F.
+
+Set Universe Polymorphism.
+
+Cumulative Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }.
+
+Section test_letin_subtyping.
+  Universe i j k i' j' k'.
+  Constraint j < j'.
+
+  Context (W : Type) (X : box@{i j k} W).
+  Definition Y := X : box@{i' j' k'} W.
+
+  Universe i1 j1 k1 i2 j2 k2.
+  Constraint i1 < i2.
+  Constraint k2 < k1.
+  Context (V : Type).
+
+  Definition Z : box@{i1 j1 k1} V := {| unwrap := V |}.
+  Definition Z' : box@{i2 j2 k2} V := {| unwrap := V |}.
+  Lemma ZZ' : @eq (box@{i2 j2 k2} V) Z Z'.
+  Proof.
+    Set Printing All. Set Printing Universes.
+    cbv.
+    reflexivity.
+  Qed.
+
+End test_letin_subtyping.
+
+Module ObligationRegression.
+  (** Test for a regression encountered when fixing obligations for
+      stronger restriction of universe context. *)
+  Require Import CMorphisms.
+  Check trans_co_eq_inv_arrow_morphism@{_ _ _ _ _  _ _ _}.
+End ObligationRegression.