add test for fdReadBuf/fdWriteBuf
authorSimon Marlow <marlowsd@gmail.com>
Fri, 29 May 2009 12:56:09 +0000 (12:56 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 29 May 2009 12:56:09 +0000 (12:56 +0000)
tests/all.T
tests/fdReadBuf001.hs [new file with mode: 0644]

index 6746643..a66f52a 100644 (file)
@@ -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 (file)
index 0000000..4c121a2
--- /dev/null
@@ -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