From edd1ee4f881f9b8023524a823bcd15759038bc76 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau
Date: Tue, 17 Jun 2014 16:33:18 +0200
Subject: Fix HoTT bug #84, binding scopes to projections.

---
 interp/notation.ml                    |  1 +
 test-suite/bugs/closed/HoTT_coq_084.v | 49 +++++++++++++++++++++++++++++++++++
 test-suite/bugs/opened/HoTT_coq_084.v | 49 -----------------------------------
 3 files changed, 50 insertions(+), 49 deletions(-)
 create mode 100644 test-suite/bugs/closed/HoTT_coq_084.v
 delete mode 100644 test-suite/bugs/opened/HoTT_coq_084.v

diff --git a/interp/notation.ml b/interp/notation.ml
index ec82c8aea3..6cc99ddb40 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -535,6 +535,7 @@ let compute_scope_class t =
   let t', _ = decompose_appvect (Reductionops.whd_betaiotazeta Evd.empty t) in
   match kind_of_term t' with
   | Var _ | Const _ | Ind _ -> ScopeRef (global_of_constr t')
+  | Proj (p, c) -> ScopeRef (ConstRef p)
   | Sort _ -> ScopeSort
   |  _ -> raise Not_found
 
diff --git a/test-suite/bugs/closed/HoTT_coq_084.v b/test-suite/bugs/closed/HoTT_coq_084.v
new file mode 100644
index 0000000000..d007e4e235
--- /dev/null
+++ b/test-suite/bugs/closed/HoTT_coq_084.v
@@ -0,0 +1,49 @@
+Set Implicit Arguments.
+Set Universe Polymorphism.
+
+Module success.
+  Unset Primitive Projections.
+
+  Record group :=
+    { carrier : Type;
+      id : carrier }.
+
+  Notation "1" := (id _) : g_scope.
+
+  Delimit Scope g_scope with g.
+  Bind Scope g_scope with carrier.
+
+  Section foo.
+    Variable g : group.
+    Variable comp : carrier g -> carrier g -> carrier g.
+
+    Check comp 1 1.
+  End foo.
+End success.
+
+Module failure.
+  Set Primitive Projections.
+
+  Record group :=
+    { carrier : Type;
+      id : carrier }.
+
+  Notation "1" := (id _) : g_scope.
+
+  Delimit Scope g_scope with g.
+  Bind Scope g_scope with carrier.
+
+  Section foo.
+    Variable g : group.
+    Variable comp : carrier g -> carrier g -> carrier g.
+
+    Check comp 1 1.
+    (* Toplevel input, characters 11-12:
+Error:
+In environment
+g : group
+comp : carrier g -> carrier g -> carrier g
+The term "1" has type "nat" while it is expected to have type "carrier g".
+    *)
+  End foo.
+End failure.
diff --git a/test-suite/bugs/opened/HoTT_coq_084.v b/test-suite/bugs/opened/HoTT_coq_084.v
deleted file mode 100644
index 5568ec244e..0000000000
--- a/test-suite/bugs/opened/HoTT_coq_084.v
+++ /dev/null
@@ -1,49 +0,0 @@
-Set Implicit Arguments.
-Set Universe Polymorphism.
-
-Module success.
-  Unset Primitive Projections.
-
-  Record group :=
-    { carrier : Type;
-      id : carrier }.
-
-  Notation "1" := (id _) : g_scope.
-
-  Delimit Scope g_scope with g.
-  Bind Scope g_scope with carrier.
-
-  Section foo.
-    Variable g : group.
-    Variable comp : carrier g -> carrier g -> carrier g.
-
-    Check comp 1 1.
-  End foo.
-End success.
-
-Module failure.
-  Set Primitive Projections.
-
-  Record group :=
-    { carrier : Type;
-      id : carrier }.
-
-  Notation "1" := (id _) : g_scope.
-
-  Delimit Scope g_scope with g.
-  Bind Scope g_scope with carrier.
-
-  Section foo.
-    Variable g : group.
-    Variable comp : carrier g -> carrier g -> carrier g.
-
-    Fail Check comp 1 1.
-    (* Toplevel input, characters 11-12:
-Error:
-In environment
-g : group
-comp : carrier g -> carrier g -> carrier g
-The term "1" has type "nat" while it is expected to have type "carrier g".
-    *)
-  End foo.
-End failure.
-- 
cgit v1.2.3