Fixing bug #2809 (anomaly when printing a module with notations due to

bad interaction between lazy evaluation of pp streams and temporary
effectful extension of global environment).

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@15457 85f007b7-540e-0410-9357-904b9bb8a0f7

4 files changed, 29 insertions, 2 deletions

diff --git a/lib/pp.ml4 b/lib/pp.ml4
index 2eb79c100e..789de81603 100644
--- a/lib/pp.ml4
+++ b/lib/pp.ml4
@@ -159,6 +159,17 @@ let tclose () = [< 'Ppcmd_close_tbox >]
 
 let (++) = Stream.iapp
 
+let rec eval_ppcmds l =
+  let rec aux l =
+    try
+      let a = match Stream.next l with
+      | Ppcmd_box (b,s) -> Ppcmd_box (b,eval_ppcmds s)
+      | a -> a in
+      let rest = aux l in
+      a :: rest
+    with Stream.Failure -> [] in
+  Stream.of_list (aux l)
+
 (* In new syntax only double quote char is escaped by repeating it *)
 let rec escape_string s =
   let rec escape_at s i =
diff --git a/lib/pp.mli b/lib/pp.mli
index bc7d58a0b4..09efc57a1d 100644
--- a/lib/pp.mli
+++ b/lib/pp.mli
@@ -41,6 +41,10 @@ val comments : ((int * int) * string) list ref
 
 val (++) : std_ppcmds -> std_ppcmds -> std_ppcmds
 
+(** {6 Evaluation. } *)
+
+val eval_ppcmds : std_ppcmds -> std_ppcmds
+
 (** {6 Derived commands. } *)
 
 val spc : unit -> std_ppcmds
diff --git a/printing/printmod.ml b/printing/printmod.ml
index 1953935aab..8864ace298 100644
--- a/printing/printmod.ml
+++ b/printing/printmod.ml
@@ -221,9 +221,9 @@ let rec printable_body dir =
     state after the printing *)
 
 let print_modexpr' env mp mexpr =
-  States.with_state_protection (print_modexpr env mp []) mexpr
+  States.with_state_protection (fun e -> eval_ppcmds (print_modexpr env mp [] e)) mexpr
 let print_modtype' env mp mty =
-  States.with_state_protection (print_modtype env mp []) mty
+  States.with_state_protection (fun e -> eval_ppcmds (print_modtype env mp [] e)) mty
 
 let print_module' env mp with_body mb =
   let name = print_modpath [] mp in
diff --git a/test-suite/success/Mod_type.v b/test-suite/success/Mod_type.v
index b847833f34..d5e1a38cf5 100644
--- a/test-suite/success/Mod_type.v
+++ b/test-suite/success/Mod_type.v
@@ -17,3 +17,15 @@ Module Bar : BAR.
   Module Foo := Fu.
 
 End Bar.
+
+(* Check bug #2809: correct printing of modules with notations *)
+
+Module C.
+  Inductive test : Type :=
+    | c1 : test
+    | c2 : nat -> test.
+
+  Notation "! x" := (c2 x) (at level 50).
+End C.
+
+Print C. (* Should print test_rect without failing *)