add test for fdReadBuf/fdWriteBuf

1 files changed, 27 insertions, 0 deletions

diff --git a/tests/fdReadBuf001.hs b/tests/fdReadBuf001.hs
new file mode 100644
index 0000000..4c121a2
--- /dev/null
+++ b/tests/fdReadBuf001.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+import System.Posix
+import Control.Monad
+import Foreign
+import Control.Concurrent
+import Data.Char
+import System.Exit
+
+size  = 10000
+block = 512
+
+main = do
+  (rd,wr) <- createPipe
+  let bytes = take size (map (fromIntegral.ord) (cycle ['a'..'z']))
+  allocaBytes size $ \p -> do
+    pokeArray p bytes
+    forkIO $ do r <- fdWriteBuf wr p (fromIntegral size)
+                when (fromIntegral r /= size) $ error "fdWriteBuf failed"
+  allocaBytes block $ \p -> do
+    let loop text = do
+           r <- fdReadBuf rd p block
+           let (chunk,rest) = splitAt (fromIntegral r) text
+           chars <- peekArray (fromIntegral r) p
+           when (chars /= chunk) $ error "mismatch"
+           when (null rest) $ exitWith ExitSuccess
+           loop rest
+    loop bytes