[commit: bytestring] ghc-7.6: Add a test for the new runBuilder stuff (ef9b67b)

[Paolo Capriotti]

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

On branch  : ghc-7.6

http://hackage.haskell.org/trac/ghc/changeset/ef9b67b155babb3f5058b857dea81d8a74ffd204

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

commit ef9b67b155babb3f5058b857dea81d8a74ffd204
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Thu Sep 6 00:28:36 2012 +0000

    Add a test for the new runBuilder stuff

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

 .../Data/ByteString/Builder/Prim/TestUtils.hs      |    1 +
 tests/builder/Data/ByteString/Builder/Tests.hs     |   72 ++++++++++++--------
 2 files changed, 45 insertions(+), 28 deletions(-)

diff --git a/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs b/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs
index 1c8cbc9..194dcf4 100644
--- a/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs
+++ b/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- Copyright   : (c) 2011 Simon Meier
 -- License     : BSD3-style (see LICENSE)
diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs
index 2ceae41..7da248f 100644
--- a/tests/builder/Data/ByteString/Builder/Tests.hs
+++ b/tests/builder/Data/ByteString/Builder/Tests.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- |
@@ -25,8 +25,9 @@ import           Data.Char (ord, chr)
 import qualified Data.DList      as D
 import           Data.Foldable (asum, foldMap)
 
-import qualified Data.ByteString      as S
-import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString          as S
+import qualified Data.ByteString.Internal as S
+import qualified Data.ByteString.Lazy     as L
 
 import           Data.ByteString.Builder
 import           Data.ByteString.Builder.Extra
@@ -45,11 +46,13 @@ import           System.IO (openTempFile, hPutStr, hClose, hSetBinaryMode)
 import           System.IO (hSetEncoding, utf8)
 #endif
 import           System.Directory
+import           Foreign (ForeignPtr, withForeignPtr, castPtr)
 
 import           TestFramework
 import           Test.QuickCheck
                    ( Arbitrary(..), oneof, choose, listOf, elements )
-import           Test.QuickCheck.Property (printTestCase)
+import           Test.QuickCheck.Property
+                   ( printTestCase, morallyDubiousIOProperty )
 
 
 tests :: [Test]
@@ -60,6 +63,7 @@ tests =
 #endif
   , testHandlePutBuilderChar8
   , testPut
+  , testRunBuilder
   ] ++
   testsEncodingToBuilder ++
   testsBinary ++
@@ -522,33 +526,45 @@ ensureFree minFree =
             freeSpace = ope' `minusPtr` op'
 
 
-{-
-testBuilderRun :: BuilderRun -> IO ()
-testBuilderRun brun = do
-    buf <- S.mallocByteString 1024
-    go buf 1024 brun
-  where
-    go :: ForeignPtr Word8 -> Int -> BuilderRun -> IO ()
-    go !buf !len brun = do
-      (wc, next) <- withForeignPtr buf $ \ptr -> brun ptr len
+------------------------------------------------------------------------------
+-- Testing the Builder runner
+------------------------------------------------------------------------------
 
+testRunBuilder :: Test
+testRunBuilder =
+    testProperty "runBuilder" prop
+  where
+    prop actions =
+        morallyDubiousIOProperty $ do
+          let (builder, _) = recipeComponents recipe
+              expected     = renderRecipe recipe
+          actual <- bufferWriterOutput (runBuilder builder)
+          return (S.unpack actual == expected)
+      where
+        recipe = Recipe Safe 0 0 mempty actions
+
+bufferWriterOutput :: BufferWriter -> IO S.ByteString
+bufferWriterOutput bwrite0 = do
+    let len0 = 8
+    buf <- S.mallocByteString len0
+    bss <- go [] buf len0 bwrite0
+    return (S.concat (reverse bss))
+  where
+    go :: [S.ByteString] -> ForeignPtr Word8 -> Int -> BufferWriter -> IO [S.ByteString]
+    go bss !buf !len bwrite = do
+      (wc, next) <- withForeignPtr buf $ \ptr -> bwrite ptr len
       bs <- getBuffer buf wc
-      print ("got bytes", wc, bs)
-
       case next of
-        BuilderDone -> print "builder done"
-        
-        BuilderMore m brun' | m <= len -> do
-          print ("more to go", m)
-          go buf len brun'
-        
-        BuilderChunk c brun' -> do
-          print ("chunk", c)
-          go buf len brun'
-
-getBuffer :: ForeignPtr Word8 -> Int -> IO S.ByteString
-getBuffer buf len = withForeignPtr buf $ \ptr -> S.packCStringLen (castPtr ptr, len)
--}
+        Done                        -> return (bs:bss)
+        More  m bwrite' | m <= len  -> go (bs:bss)   buf len bwrite'
+                        | otherwise -> do let len' = m
+                                          buf' <- S.mallocByteString len'
+                                          go (bs:bss) buf' len' bwrite'
+        Chunk c bwrite'             -> go (c:bs:bss) buf len bwrite'
+
+    getBuffer :: ForeignPtr Word8 -> Int -> IO S.ByteString
+    getBuffer buf len = withForeignPtr buf $ \ptr ->
+                          S.packCStringLen (castPtr ptr, len)
 
 
 ------------------------------------------------------------------------------