Merge pull request #35 from ndmitchell/master
authorDavid Terei <github@davidterei.com>
Thu, 2 Jun 2016 21:24:54 +0000 (14:24 -0700)
committerDavid Terei <github@davidterei.com>
Thu, 2 Jun 2016 21:24:54 +0000 (14:24 -0700)
Remove harmful $! forcing in beside

pretty.cabal
src/Text/PrettyPrint/Annotated/HughesPJ.hs
tests/Test.hs
tests/UnitT32.hs [new file with mode: 0755]

index 4bfef78..f3116eb 100644 (file)
@@ -62,6 +62,7 @@ Test-Suite test-pretty
         UnitLargeDoc
         UnitPP1
         UnitT3911
+        UnitT32
     extensions: CPP, BangPatterns, DeriveGeneric
     include-dirs: src/Text/PrettyPrint/Annotated
     ghc-options: -rtsopts -with-rtsopts=-K2M
index 77a59c2..33623ff 100644 (file)
@@ -695,7 +695,7 @@ beside p@(Beside p1 g1 q1) g2 q2
          | otherwise             = beside (reduceDoc p) g2 q2
 beside p@(Above{})         g q   = let !d = reduceDoc p in beside d g q
 beside (NilAbove p)        g q   = nilAbove_ $! beside p g q
-beside (TextBeside t p)    g q   = TextBeside t $! rest
+beside (TextBeside t p)    g q   = TextBeside t rest
                                where
                                   rest = case p of
                                            Empty -> nilBeside g q
index bbcd0f7..4d23ac0 100644 (file)
@@ -18,6 +18,7 @@ import TestStructures
 import UnitLargeDoc
 import UnitPP1
 import UnitT3911
+import UnitT32
 
 import Control.Monad
 import Data.Char (isSpace)
@@ -39,6 +40,7 @@ main = do
     -- unit tests
     testPP1
     testT3911
+    testT32
     testLargeDoc
 
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/tests/UnitT32.hs b/tests/UnitT32.hs
new file mode 100755 (executable)
index 0000000..8c1eb85
--- /dev/null
@@ -0,0 +1,9 @@
+-- Test from https://github.com/haskell/pretty/issues/32#issuecomment-223073337
+module UnitT32 where
+
+import Text.PrettyPrint.HughesPJ
+
+import TestUtils
+
+testT32 :: IO ()
+testT32 = simpleMatch "T3911" (replicate 10 'x') $ take 10 $ render $ hcat $ repeat $ text "x"