From e8ccf6120f3765e04c527bca8b2b1fffc6df08ca Mon Sep 17 00:00:00 2001
From: Hugo Herbelin
Date: Tue, 21 Aug 2018 14:59:23 +0200
Subject: Fixing #8270 (cbn was calling zeta even when not asked for).

---
 pretyping/reductionops.ml     | 12 ++++++++++++
 pretyping/reductionops.mli    |  3 +++
 proofs/redexpr.ml             |  2 +-
 test-suite/bugs/closed/8270.v | 15 +++++++++++++++
 4 files changed, 31 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/closed/8270.v

diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index ba40262815..f133eb9963 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -628,6 +628,18 @@ let safe_meta_value sigma ev =
   try Some (Evd.meta_value sigma ev)
   with Not_found -> None
 
+let strong_with_flags whdfun flags env sigma t =
+  let push_rel_check_zeta d env =
+    let open CClosure.RedFlags in
+    let d = match d with
+      | LocalDef (na,c,t) when not (red_set flags fZETA) -> LocalAssum (na,t)
+      | d -> d in
+    push_rel d env in
+  let rec strongrec env t =
+    map_constr_with_full_binders sigma
+      push_rel_check_zeta strongrec env (whdfun flags env sigma t) in
+  strongrec env t
+
 let strong whdfun env sigma t =
   let rec strongrec env t =
     map_constr_with_full_binders sigma push_rel strongrec env (whdfun env sigma t) in
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 07eeec9276..dd3cd26f0f 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -144,6 +144,9 @@ val pr_state : state -> Pp.t
 
 (** {6 Reduction Function Operators } *)
 
+val strong_with_flags :
+  (CClosure.RedFlags.reds -> reduction_function) ->
+  (CClosure.RedFlags.reds -> reduction_function)
 val strong : reduction_function -> reduction_function
 val local_strong : local_reduction_function -> local_reduction_function
 val strong_prodspine : local_reduction_function -> local_reduction_function
diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml
index 629b77be2a..44685d2bbd 100644
--- a/proofs/redexpr.ml
+++ b/proofs/redexpr.ml
@@ -52,7 +52,7 @@ let whd_cbn flags env sigma t =
   Reductionops.Stack.zip ~refold:true sigma state
 
 let strong_cbn flags =
-  strong (whd_cbn flags)
+  strong_with_flags whd_cbn flags
 
 let simplIsCbn = ref (false)
 let _ = Goptions.declare_bool_option {
diff --git a/test-suite/bugs/closed/8270.v b/test-suite/bugs/closed/8270.v
new file mode 100644
index 0000000000..f36f757f10
--- /dev/null
+++ b/test-suite/bugs/closed/8270.v
@@ -0,0 +1,15 @@
+(* Don't do zeta in cbn when not asked for *)
+
+Goal let x := 0 in
+     let y := x in
+     y = 0.
+  (* We use "cofix" as an example because there are obviously no
+     cofixpoints in sight.  This problem arises with any set of
+     reduction flags (not including zeta where the lets are of course reduced away) *)
+  cbn cofix.
+  intro x.
+  unfold x at 1. (* Should succeed *)
+  Undo 2.
+  cbn zeta.
+  Fail unfold x at 1.
+Abort.
-- 
cgit v1.2.3