test hGetBufSome

2 files changed, 82 insertions, 1 deletions

diff --git a/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.hs b/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.hs
index 0e8e0bc0d1..365081ca58 100644
--- a/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.hs
+++ b/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.hs
@@ -8,6 +8,7 @@ import Foreign.C
 import System.Exit
 import Control.Exception
 import Control.Monad
+import GHC.IO.Handle.Text (hGetBufSome)
 
 
 main = do
@@ -19,7 +20,7 @@ main = do
 
   zipWithM_ ($) 
 	  [ f rbuf wbuf
-	    | f <- [hGetBufTest, hGetBufNBTest],
+	    | f <- [hGetBufTest, hGetBufNBTest, hGetBufSomeTest],
 	      rbuf <- [buf1,buf2,buf3],
 	      wbuf <- [buf1,buf2,buf3]
 	    ]
@@ -172,3 +173,47 @@ writeProcNB m1 m2 h = do
     hFlush h
     putMVar m1 ()
   hClose h
+
+-- -----------------------------------------------------------------------------
+-- hGetBufSome:
+
+hGetBufSomeTest rbuf wbuf n = do
+  (read,write) <- createPipe
+  hread <- fdToHandle read
+  hwrite <- fdToHandle write
+  m1 <- newEmptyMVar
+  m2 <- newEmptyMVar
+  finished <- newEmptyMVar
+  hSetBuffering hread rbuf
+  hSetBuffering hwrite wbuf
+  forkIO (readProcSome m1 m2 finished hread)
+  writeProcNB m1 m2 hwrite
+  takeMVar finished
+  putStrLn ("test " ++ show n ++ " OK")
+
+
+readProcSome :: MVar () -> MVar () -> MVar () -> Handle -> IO ()
+readProcSome m1 m2 finished h = do
+  buf <- mallocBytes 20
+
+  let
+    loop 0 = return ()
+    loop n = do putMVar m2 (); takeMVar m1
+		r <- hGetBufSome h buf read_size
+		if (r /= msg_length) 
+			then do hPutStr stderr ("error: " ++ show r)
+			        exitFailure
+			else do s <- peekCStringLen (buf,r)
+			        hPutStr stdout (show n ++ " ")
+			        loop (n-1)
+  loop 100
+  hPutStr stdout "\n"
+  putMVar m2 (); takeMVar m1
+  r <- hGetBufSome h buf read_size -- EOF, should get short read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  r <- hGetBufSome h buf read_size -- EOF, should get zero-length read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  hClose h
+  putMVar finished ()
diff --git a/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.stdout b/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.stdout
index 5026c71377..694ff4eedf 100644
--- a/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.stdout
+++ b/testsuite/tests/ghc-regress/lib/IO/hGetBuf001.stdout
@@ -79,3 +79,39 @@ got 0:
 got 3: end
 got 0: 
 test 18 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 19 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 20 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 21 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 22 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 23 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 24 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 25 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 26 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 27 OK