[commit: haskeline] master: Prevent crash on Windows when writing many characters at once. (7f3aa2c)

Repository : ssh://darcs.haskell.org//srv/darcs/packages/haskeline

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/7f3aa2c96237defaa0600ecb632d43ebbf6d338b

>---------------------------------------------------------------

commit 7f3aa2c96237defaa0600ecb632d43ebbf6d338b
Author: Judah Jacobson <[email protected]>
Date:   Wed Jul 18 21:03:25 2012 +0000

    Prevent crash on Windows when writing many characters at once.
    
    A couple cases which are known to have triggered this are:
    - Entering a long (>2^15) input line
    - Tab-completing a folder containing many files, with completionPaging:False

>---------------------------------------------------------------

 System/Console/Haskeline/Backend/Win32.hsc |   16 ++++++++++++----
 1 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc
index 2a34c84..87b51a6 100644
--- a/System/Console/Haskeline/Backend/Win32.hsc
+++ b/System/Console/Haskeline/Backend/Win32.hsc
@@ -212,11 +212,19 @@ writeConsole :: HANDLE -> String -> IO ()
 -- For some reason, Wine returns False when WriteConsoleW is called on an empty
 -- string.  Easiest fix: just don't call that function.
 writeConsole _ "" = return ()
-writeConsole h str = withArray tstr $ \t_arr -> alloca $ \numWritten -> do
-    failIfFalse_ "WriteConsole" 
-        $ c_WriteConsoleW h t_arr (toEnum $ length str) numWritten nullPtr
+writeConsole h str = writeConsole' >> writeConsole h ys
   where
-    tstr = map (toEnum . fromEnum) str
+    (xs,ys) = splitAt limit str
+    -- WriteConsoleW has a buffer limit which is documented as 32768 word8's,
+    -- but bug reports from online suggest that the limit may be lower (~25000).
+    -- To be safe, we pick a round number we know to be less than the limit.
+    limit = 20000 -- known to be less than WriteConsoleW's buffer limit
+    writeConsole'
+        = withArray (map (toEnum . fromEnum) xs)
+            $ \t_arr -> alloca $ \numWritten -> do
+                    failIfFalse_ "WriteConsoleW"
+                        $ c_WriteConsoleW h t_arr (toEnum $ length xs)
+                                numWritten nullPtr
 
 foreign import WINDOWS_CCONV "windows.h MessageBeep" c_messageBeep :: UINT -> IO Bool