From 5fb53743cc14047b4be12c188c21c6f679bdbd8f Mon Sep 17 00:00:00 2001
From: Pierre-Marie Pédrot
Date: Mon, 28 Aug 2017 01:07:07 +0200
Subject: Fix BZ#5697: Congruence does not work with primitive projections.

The code generating the projection was unconditionally generating
pattern-matchings, although this is incorrect for primitive records.
---
 tactics/equality.ml           |  3 ++-
 test-suite/bugs/closed/5697.v | 10 ++++++++++
 2 files changed, 12 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/closed/5697.v

diff --git a/tactics/equality.ml b/tactics/equality.ml
index ad6abfa1f6..3ea9538f38 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -922,7 +922,8 @@ let build_selector env sigma dirn c ind special default =
   let brl =
     List.map build_branch(List.interval 1 (Array.length mip.mind_consnames)) in
   let ci = make_case_info env ind RegularStyle in
-  mkCase (ci, p, c, Array.of_list brl)
+  let ans = Inductiveops.make_case_or_project env sigma indf ci p c (Array.of_list brl) in
+  ans
 
 let build_coq_False () = pf_constr_of_global (build_coq_False ())
 let build_coq_True () = pf_constr_of_global (build_coq_True ())
diff --git a/test-suite/bugs/closed/5697.v b/test-suite/bugs/closed/5697.v
new file mode 100644
index 0000000000..a17229aaff
--- /dev/null
+++ b/test-suite/bugs/closed/5697.v
@@ -0,0 +1,10 @@
+Set Primitive Projections.
+
+Record foo : Type := Foo { foo_car: nat }.
+
+Goal forall x y : nat, x <> y -> Foo x <> Foo y.
+Proof.
+intros.
+intros H'.
+congruence.
+Qed.
-- 
cgit v1.2.3


From 4bbe2e4e2a9d5dea1a07f8cf0d7e3aeeed609201 Mon Sep 17 00:00:00 2001
From: Pierre-Marie Pédrot
Date: Mon, 28 Aug 2017 01:27:19 +0200
Subject: Properly handling parameters of primitive projections in cctac.

---
 plugins/cc/cctac.ml           | 3 ++-
 test-suite/bugs/closed/5697.v | 9 +++++++++
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index 11d3a6d1f4..5a4c52456d 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -84,7 +84,8 @@ let rec decompose_term env sigma t=
     | Proj (p, c) -> 
 	let canon_const kn = Constant.make1 (Constant.canonical kn) in 
 	let p' = Projection.map canon_const p in
-	(Appli (Symb (Term.mkConst (Projection.constant p')), decompose_term env sigma c))
+	let c = Retyping.expand_projection env sigma p' c [] in
+	decompose_term env sigma c
     | _ ->
        let t = Termops.strip_outer_cast sigma t in
        if closed0 sigma t then Symb (EConstr.to_constr sigma t) else raise Not_found
diff --git a/test-suite/bugs/closed/5697.v b/test-suite/bugs/closed/5697.v
index a17229aaff..c653f992af 100644
--- a/test-suite/bugs/closed/5697.v
+++ b/test-suite/bugs/closed/5697.v
@@ -8,3 +8,12 @@ intros.
 intros H'.
 congruence.
 Qed.
+
+Record bar (A : Type) : Type := Bar { bar_car: A }.
+
+Goal forall x y : nat, x <> y -> Bar nat x <> Bar nat y.
+Proof.
+intros.
+intros H'.
+congruence.
+Qed.
-- 
cgit v1.2.3