From 6de30407e4ab286a04423510d6d955a51ef9d9f2 Mon Sep 17 00:00:00 2001
From: Robbert Krebbers <mail@robbertkrebbers.nl>
Date: Thu, 24 Jun 2021 09:54:28 +0200
Subject: [PATCH] Fix potential stack overflow related to `Pretty N`.

---
 tests/pretty.v    | 12 ++++++++++++
 theories/pretty.v |  2 +-
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/tests/pretty.v b/tests/pretty.v
index 8557d8fe..6bb0768f 100644
--- a/tests/pretty.v
+++ b/tests/pretty.v
@@ -1,4 +1,5 @@
 From stdpp Require Import pretty.
+From Coq Require Import Ascii.
 
 Section N.
   Local Open Scope N_scope.
@@ -17,6 +18,17 @@ Section N.
   Proof. reflexivity. Qed.
 End N.
 
+(** Minimized version of:
+
+  https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/Stack.20overflow.20in.20Qed.2E
+
+Fixed by making the [wp_guard] in [pretty_N_go] proportional to the
+size of the input so that it blocks in case the input is an open term. *)
+Lemma test_no_stack_overflow p n :
+  get n (pretty (N.pos p)) ≠ Some "_"%char →
+  get (S n) ("-" +:+ pretty (N.pos p)) ≠ Some "_"%char.
+Proof. intros Hlem. apply Hlem. Qed.
+
 Section nat.
   Local Open Scope nat_scope.
 
diff --git a/theories/pretty.v b/theories/pretty.v
index 7ba38b33..d3d0fff4 100644
--- a/theories/pretty.v
+++ b/theories/pretty.v
@@ -23,7 +23,7 @@ Fixpoint pretty_N_go_help (x : N) (acc : Acc (<)%N x) (s : string) : string :=
   | right _ => s
   end.
 Definition pretty_N_go (x : N) : string → string :=
-  pretty_N_go_help x (wf_guard 32 N.lt_wf_0 x).
+  pretty_N_go_help x (wf_guard (S (N.size_nat x)) N.lt_wf_0 x).
 Global Instance pretty_N : Pretty N := λ x,
   if decide (x = 0)%N then "0" else pretty_N_go x "".
 
-- 
GitLab