add test for fdReadBuf/fdWriteBuf

2 files changed, 29 insertions, 0 deletions

diff --git a/tests/all.T b/tests/all.T
index 6746643..a66f52a 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -26,3 +26,5 @@ test('getUserEntryForName', compose(conf, expect_fail), compile_and_run,
 
 
 test('signals004', normal, compile_and_run, ['-package unix'])
+
+test('fdReadBuf001', only_ways(['threaded1','threaded2','ghci']), compile_and_run, ['-package unix'])
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