Streamline.receiveLine was blocking after the end of line. Fixed.

Added test for detecting a blocking Streamline.receiveLine.

src/System/IO/Uniform/Streamline.hs

@@ -15,7 +15,6 @@ import Control.Monad.IO.Class
 import System.IO.Error
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
-import Data.Char (ord)
 import Data.Word8 (Word8)
 import Data.IP (IP)
 
@@ -240,7 +239,7 @@ setEcho e = Streamline $ \cl -> return ((), cl{echo=e})
 parseLine :: A.Parser ByteString
 parseLine = do
   l <- A.takeTill isEol
-  (A.string "\r\n" <|> A.string "\n")
+  (A.word8 13 >> A.word8 10) <|>  A.word8 10
   return l
   
 lineWithEol :: A.Parser (ByteString, ByteString)
@@ -254,7 +253,7 @@ lineScanner False c = Just $ isEol c
 lineScanner True c = if isEol c then Just True else Nothing
 
 isEol :: Word8 -> Bool
-isEol c = elem c (map (fromIntegral . ord) "\r\n")
+isEol c = c == 13 || c == 10
 
 eofError :: MonadIO m => String -> m a
 eofError msg = liftIO . ioError $ mkIOError eofErrorType msg Nothing Nothing

src/System/IO/Uniform/Targets.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE InterruptibleFFI #-}
 
 module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where
 
@@ -245,24 +246,24 @@ getPeer s = allocaArray 16 (
 closePort :: BoundedPort -> IO ()
 closePort p = c_closePort (lis p)
 
-foreign import ccall "getPort" c_getPort :: CInt -> IO (Ptr Nethandler)
-foreign import ccall "createFromHandler" c_accept :: Ptr Nethandler -> IO (Ptr SockDs)
-foreign import ccall "createFromFileName" c_createFile :: CString -> IO (Ptr FileDs)
-foreign import ccall "createToIPv4Host" c_connect4 :: CUInt -> CInt -> IO (Ptr SockDs)
-foreign import ccall "createToIPv6Host" c_connect6 :: Ptr CUChar -> CInt -> IO (Ptr SockDs)
+foreign import ccall safe "getPort" c_getPort :: CInt -> IO (Ptr Nethandler)
+foreign import ccall safe "createFromHandler" c_accept :: Ptr Nethandler -> IO (Ptr SockDs)
+foreign import ccall safe "createFromFileName" c_createFile :: CString -> IO (Ptr FileDs)
+foreign import ccall safe "createToIPv4Host" c_connect4 :: CUInt -> CInt -> IO (Ptr SockDs)
+foreign import ccall safe "createToIPv6Host" c_connect6 :: Ptr CUChar -> CInt -> IO (Ptr SockDs)
 
-foreign import ccall "startSockTls" c_startSockTls :: Ptr SockDs -> CString -> CString -> IO (Ptr TlsDs)
-foreign import ccall "getPeer" c_getPeer :: Ptr SockDs -> Ptr CUInt -> Ptr CUChar -> Ptr CInt -> IO (CInt)
+foreign import ccall safe "startSockTls" c_startSockTls :: Ptr SockDs -> CString -> CString -> IO (Ptr TlsDs)
+foreign import ccall safe "getPeer" c_getPeer :: Ptr SockDs -> Ptr CUInt -> Ptr CUChar -> Ptr CInt -> IO (CInt)
 
-foreign import ccall "closeSockDs" c_closeSock :: Ptr SockDs -> IO ()
-foreign import ccall "closeFileDs" c_closeFile :: Ptr FileDs -> IO ()
-foreign import ccall "closeHandler" c_closePort :: Ptr Nethandler -> IO ()
-foreign import ccall "closeTlsDs" c_closeTls :: Ptr TlsDs -> IO ()
+foreign import ccall safe "closeSockDs" c_closeSock :: Ptr SockDs -> IO ()
+foreign import ccall safe "closeFileDs" c_closeFile :: Ptr FileDs -> IO ()
+foreign import ccall safe "closeHandler" c_closePort :: Ptr Nethandler -> IO ()
+foreign import ccall safe "closeTlsDs" c_closeTls :: Ptr TlsDs -> IO ()
 
-foreign import ccall "fileDsSend" c_sendFile :: Ptr FileDs -> Ptr CChar -> CInt -> IO CInt
-foreign import ccall "sockDsSend" c_sendSock :: Ptr SockDs -> Ptr CChar -> CInt -> IO CInt
-foreign import ccall "tlsDsSend" c_sendTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "fileDsSend" c_sendFile :: Ptr FileDs -> Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "sockDsSend" c_sendSock :: Ptr SockDs -> Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "tlsDsSend" c_sendTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt
 
-foreign import ccall "fileDsRecv" c_recvFile :: Ptr FileDs -> Ptr CChar -> CInt -> IO CInt
-foreign import ccall "sockDsRecv" c_recvSock :: Ptr SockDs -> Ptr CChar -> CInt -> IO CInt
-foreign import ccall "tlsDsRecv" c_recvTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "fileDsRecv" c_recvFile :: Ptr FileDs -> Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "sockDsRecv" c_recvSock :: Ptr SockDs -> Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "tlsDsRecv" c_recvTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt

test/Lazyness.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Lazyness (tests) where
+
+import Distribution.TestSuite
+import Control.Concurrent(forkIO) 
+import qualified System.IO.Uniform as U
+import qualified System.IO.Uniform.Streamline as S
+import System.Timeout (timeout)  
+
+tests :: IO [Test]
+tests = return [Test readLine]
+  where
+    readLine = TestInstance
+      {run = testReadLine,
+       name = "Lazyness of readLine",
+       tags = [],
+       options = [],
+       setOption = \_ _ -> Right readLine
+      }
+      
+testReadLine :: IO Progress
+testReadLine = do
+  recv <- U.bindPort 8888
+  forkIO $ S.withClient (\_ _ -> do
+                            l <- S.receiveLine
+                            S.send l
+                            S.send "\n"
+                            return ()
+                        ) recv
+  r <- timeout 1000000 $ S.withServer (do
+                                     S.send "A test\n"
+                                     S.receiveLine
+                                     return ()
+                                 ) "127.0.0.1" 8888
+  case r of
+    Just _ -> return . Finished $ Pass
+    Nothing -> return . Finished . Fail $ "Timeout on Streamline.readLine"
+
+
+
+

uniform-io.cabal

@@ -10,7 +10,7 @@ name:                uniform-io
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:    0.1.0.0
+version:    0.1.1.0
 
 -- A short (one-line) description of the package.
 synopsis:   Uniform IO over files, network, watever.
@@ -112,3 +112,14 @@ library
   install-includes: ds.h
   C-Sources: src/System/IO/Uniform/ds.c
   extra-libraries: ssl
+
+Test-suite lazyness
+  type: detailed-0.9
+  test-module: Lazyness
+  hs-source-dirs:
+    test
+  build-depends:
+    base >=4.7 && <5.0,
+    Cabal >= 1.9.2,
+    uniform-io == 0.1.1.0
+  ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded