From 56750f021ac396ef6da59d1aa830adea3e53c08c Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Wed, 9 Dec 2020 15:56:54 +0100
Subject: [PATCH] Fix stack overflow on large string constants (#1562)

---
 CHANGES.md              |  4 +++-
 lib/Fmt.ml              | 20 +++++++++++---------
 test/cli/large_string.t |  3 +++
 3 files changed, 17 insertions(+), 10 deletions(-)
 create mode 100644 test/cli/large_string.t

diff --git a/CHANGES.md b/CHANGES.md
index 5439fa6a11..0d575d843d 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -16,9 +16,11 @@
   + Fix comments on the same line as prev and next elements (#1556, @gpetiot)
 
   + Break or-patterns after comments and preserve their position at the end of line (#1555, @gpetiot)
-  
+
   + Fix linebreak between signature items of the same group (#1560, @gpetiot)
 
+  + Fix stack overflow on large string constants (#1562, @gpetiot)
+
 #### Changes
 
   + Add buffer filename in the logs when applying ocamlformat (#1557, @dannywillems)
diff --git a/lib/Fmt.ml b/lib/Fmt.ml
index d4065683ab..09974bda5b 100644
--- a/lib/Fmt.ml
+++ b/lib/Fmt.ml
@@ -137,16 +137,18 @@ let list_pn x1N pp =
   | [] -> noop
   | [x1] -> lazy_ (fun () -> pp ~prev:None x1 ~next:None)
   | x1 :: (x2 :: _ as x2N) ->
-      lazy_ (fun () -> pp ~prev:None x1 ~next:(Some x2))
-      $
-      let rec list_pn_ prev = function
-        | [] -> noop
-        | [xI] -> lazy_ (fun () -> pp ~prev:(Some prev) xI ~next:None)
-        | xI :: (xJ :: _ as xJN) ->
-            lazy_ (fun () -> pp ~prev:(Some prev) xI ~next:(Some xJ))
-            $ list_pn_ xI xJN
+      let l =
+        let rec aux (prev, acc) = function
+          | [] -> acc
+          | [xI] -> aux (xI, (Some prev, xI, None) :: acc) []
+          | xI :: (xJ :: _ as xJN) ->
+              aux (xI, (Some prev, xI, Some xJ) :: acc) xJN
+        in
+        aux (x1, [(None, x1, Some x2)]) x2N
       in
-      list_pn_ x1 x2N
+      List.rev_map l ~f:(fun (prev, x, next) ->
+          lazy_ (fun () -> pp ~prev x ~next) )
+      |> sequence
 
 let list_fl xs pp =
   list_pn xs (fun ~prev x ~next ->
diff --git a/test/cli/large_string.t b/test/cli/large_string.t
new file mode 100644
index 0000000000..32c5ccafcd
--- /dev/null
+++ b/test/cli/large_string.t
@@ -0,0 +1,3 @@
+  $ echo "let _ = \"$(printf '%*s' 300000 | sed 's/ /_ _/g')\"" > a.ml
+
+  $ ocamlformat --impl a.ml -o /dev/null