From 26d532da9063cdac9c693ebed29551662158bbb3 Mon Sep 17 00:00:00 2001
From: msozeau
Date: Fri, 25 Jul 2008 13:16:32 +0000
Subject: A better test for relations being setoids or not: do leibniz rewrite
 iff the applied relation is an abbreviation for @eq. Fixes bug #1915.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11264 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 tactics/equality.ml                      | 13 ++++++++++---
 test-suite/bugs/closed/shouldfail/1915.v |  6 ++++++
 2 files changed, 16 insertions(+), 3 deletions(-)
 create mode 100644 test-suite/bugs/closed/shouldfail/1915.v

diff --git a/tactics/equality.ml b/tactics/equality.ml
index 8831a9e572..8d849e643d 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -88,12 +88,20 @@ let general_s_rewrite_clause = function
 let general_setoid_rewrite_clause = ref general_s_rewrite_clause
 let register_general_setoid_rewrite_clause = (:=) general_setoid_rewrite_clause
 
+let dest_applied_relation t =
+  match kind_of_term t with
+  | App (c, args) when Array.length args >= 2 ->
+      mkApp (c, Array.append (Array.sub args 0 (Array.length args - 2)) [|mkProp;mkProp|])
+  | _ -> t
+
 let general_rewrite_ebindings_clause cls lft2rgt occs (c,l) with_evars gl =
   let ctype = pf_apply get_type_of gl c in 
   let env = pf_env gl in
   let sigma = project gl in 
-  let _,t = splay_prod env sigma ctype in
-    match match_with_equation t with
+  let t = snd (decompose_prod (whd_betaiotazeta ctype)) in 
+  let head = dest_applied_relation t in
+  let _,t' = splay_prod env sigma head in
+    match match_with_equation t' with
     | None -> 
 	if l = NoBindings
 	then !general_setoid_rewrite_clause cls lft2rgt occs c ~new_goals:[] gl
@@ -114,7 +122,6 @@ let general_rewrite_ebindings_clause cls lft2rgt occs (c,l) with_evars gl =
 	    try general_elim_clause with_evars cls (c,l) (elim,NoBindings) gl
 	    with e -> 
 	      let eq = build_coq_eq () in
-	      let t = snd (decompose_prod (whd_betaiotazeta ctype)) in 
 	      let head = if isApp t then fst (destApp t) else t in 
 		if not (eq_constr eq head) then
 		  try !general_setoid_rewrite_clause cls lft2rgt occs c ~new_goals:[] gl
diff --git a/test-suite/bugs/closed/shouldfail/1915.v b/test-suite/bugs/closed/shouldfail/1915.v
new file mode 100644
index 0000000000..a96a482c68
--- /dev/null
+++ b/test-suite/bugs/closed/shouldfail/1915.v
@@ -0,0 +1,6 @@
+
+Require Import Setoid.
+
+Goal forall x, impl True (x = 0) -> x = 0 -> False.
+intros x H E.
+rewrite H in E.
\ No newline at end of file
-- 
cgit v1.2.3