[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

John Goerzen jgoerzen at complete.org
Fri Apr 23 14:51:52 UTC 2010


The following commit has been merged in the master branch:
commit 5b98b22530e889382141b9e79fbc3b17de1dfb2f
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Dec 21 00:26:10 2004 +0100

    Fixed a MemoryBuffer vPutStr bug
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-100)

diff --git a/ChangeLog b/ChangeLog
index bea6e64..71e88c6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-20 17:26:10 GMT	John Goerzen <jgoerzen at complete.org>	patch-100
+
+    Summary:
+      Fixed a MemoryBuffer vPutStr bug
+    Revision:
+      missingh--head--0.7--patch-100
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVIO.hs testsrc/HVIOtest.hs
+
+
 2004-12-20 17:14:02 GMT	John Goerzen <jgoerzen at complete.org>	patch-99
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVIO.hs b/libsrc/MissingH/IO/HVIO.hs
index d8a29a3..8278087 100644
--- a/libsrc/MissingH/IO/HVIO.hs
+++ b/libsrc/MissingH/IO/HVIO.hs
@@ -479,12 +479,16 @@ data storage.  This problem will be fixed eventually.
 -}
 newtype MemoryBuffer = MemoryBuffer (VIOCloseSupport (Int, String))
 
-{- | Create a new 'MemoryBuffer' instance.  The buffer is initially empty;
-you can put things in it by using the normal 'vPutStr' calls, and reset to
-the beginning by using the normal 'vRewind' call. -}
-newMemoryBuffer :: IO MemoryBuffer
-newMemoryBuffer = do ref <- newIORef (True, (0, ""))
-                     return (MemoryBuffer ref)
+{- | Create a new 'MemoryBuffer' instance.  The buffer is initialized
+to the value passed, and the pointer is placed at the beginning of the file.
+
+You can put things in it by using the normal 'vPutStr' calls, and reset to
+the beginning by using the normal 'vRewind' call.
+
+To create an empty buffer, pass the initial value @\"\"@. -}
+newMemoryBuffer :: String -> IO MemoryBuffer
+newMemoryBuffer init = do ref <- newIORef (True, (0, init))
+                          return (MemoryBuffer ref)
 
 vrv (MemoryBuffer x) = x
 
@@ -522,7 +526,7 @@ instance HVIOWriter MemoryBuffer where
     vPutStr h s = do (pos, buf) <- vioc_get (vrv h)
                      let (pre, post) = splitAt pos buf
                      let newbuf = pre ++ s ++ (drop (length buf) post)
-                     vioc_set (vrv h) (pos + (length buf), newbuf)
+                     vioc_set (vrv h) (pos + (length s), newbuf)
     vPutChar h c = vPutStr h [c]
 
 instance HVIOSeeker MemoryBuffer where
diff --git a/testsrc/HVIOtest.hs b/testsrc/HVIOtest.hs
index c6fc89b..31ffd59 100644
--- a/testsrc/HVIOtest.hs
+++ b/testsrc/HVIOtest.hs
@@ -28,6 +28,24 @@ ioeq :: (Show a, Eq a) => a -> IO a -> Assertion
 ioeq exp inp = do x <- inp
                   exp @=? x
 
+test_MemoryBuffer =
+    let f inp testfunc = TestLabel inp $ TestCase $ do x <- newMemoryBuffer inp
+                                                       testfunc x
+        in
+        [
+         f "" (\x -> do True `ioeq` vIsOpen x
+                        assertRaises "eof error" (IOException $ mkIOError eofErrorType "" Nothing Nothing) (vGetChar x)
+                        vPutStrLn x "Line1"
+                        vPutStrLn x "Line2"
+                        vRewind x
+                        "Line1" `ioeq` vGetLine x
+                        "Line2" `ioeq` vGetLine x
+                        assertRaises "eof error" (IOException $ mkIOError eofErrorType "" Nothing Nothing) (vGetLine x)
+                        vRewind x
+                        "Line1\nLine2\n" `ioeq` vGetContents x
+              )
+        ]
+
 test_StreamReader =
     let f inp testfunc = TestLabel inp $ TestCase $ do x <- newStreamReader inp
                                                        testfunc x
@@ -58,5 +76,6 @@ test_StreamReader =
            )
         ]
 
-tests = TestList [TestLabel "streamReader" (TestList test_StreamReader)
+tests = TestList [TestLabel "streamReader" (TestList test_StreamReader),
+                  TestLabel "MemoryBuffer" (TestList test_MemoryBuffer)
                  ]
\ No newline at end of file

-- 
haskell-testpack



More information about the Pkg-haskell-commits mailing list