diff --git a/CONTRIBUTORS b/CONTRIBUTORS --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -3,6 +3,7 @@ - Gregory Collins - Gabriel Gonzalez + - Ignat Insarov ------------------------------------------------------------------------------ Contains some code ported from the "blaze-builder-enumerator" package by Simon diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,21 @@ +# Version 1.5.2.0 +- Add `contraunzip`. + +- Guard support for `network` and `zlib` by cabal flags, to support platforms + like GHCJS where they are not available. + +# Version 1.5.1.0 +Fix [stackage#4312](https://github.com/commercialhaskell/stackage/issues/4312): Relax `network` upper bound + +# Version 1.5.0.1 +Bugfix: `concurrentMerge []` should not block forever, even if this case is +pathological. + +# Version 1.5.0.0 +- Changed the behaviour of `ByteString.splitOn` to not emit empty string if the + input ends in the delimiter; now `lines` should match Prelude's. Bumped major + version because this is a potentially breaking change (even if it is a bugfix.) + # Version 1.4.1.0 - Added `writeTo` export to the main module (forgotten when it was added to diff --git a/io-streams.cabal b/io-streams.cabal --- a/io-streams.cabal +++ b/io-streams.cabal @@ -1,5 +1,5 @@ Name: io-streams -Version: 1.4.1.0 +Version: 1.5.2.2 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams @@ -7,7 +7,21 @@ Maintainer: Gregory Collins Cabal-version: >= 1.10 Synopsis: Simple, composable, and easy-to-use stream I/O -Tested-With: GHC==7.8.4, GHC==7.8.3, GHC==7.6.3, GHC==7.4.2 +Tested-With: + GHC == 9.4.1 + GHC == 9.2.4 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 + GHC == 7.8.4 + GHC == 7.6.3 + GHC == 7.4.2 + Bug-Reports: https://github.com/snapframework/io-streams/issues Description: /Overview/ @@ -84,6 +98,16 @@ Description: Do not run interactive tests Default: False +Flag Zlib + Description: Include zlib support + Default: True + Manual: True + +Flag Network + Description: Include network support + Default: True + Manual: True + ------------------------------------------------------------------------------ Library hs-source-dirs: src @@ -92,8 +116,6 @@ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind - ghc-prof-options: -auto-all - Exposed-modules: System.IO.Streams, System.IO.Streams.Attoparsec, System.IO.Streams.Attoparsec.ByteString, @@ -107,34 +129,42 @@ System.IO.Streams.Handle, System.IO.Streams.File, System.IO.Streams.List, - System.IO.Streams.Network, System.IO.Streams.Process, System.IO.Streams.Text, System.IO.Streams.Vector, - System.IO.Streams.Zlib, System.IO.Streams.Internal, System.IO.Streams.Tutorial Other-modules: System.IO.Streams.Internal.Attoparsec, - System.IO.Streams.Internal.Network, System.IO.Streams.Internal.Search Build-depends: base >= 4 && <5, - attoparsec >= 0.10 && <0.14, - bytestring >= 0.9 && <0.11, - bytestring-builder >= 0.10 && <0.11, - network >= 2.3 && <2.7, - primitive >= 0.2 && <0.7, + attoparsec >= 0.10 && <0.15, + bytestring >= 0.9 && <0.12, + primitive >= 0.2 && <0.8, process >= 1.1 && <1.7, - text >= 0.10 && <1.3, - time >= 1.2 && <1.9, - transformers >= 0.2 && <0.6, - vector >= 0.7 && <0.13, - zlib-bindings >= 0.1 && <0.2 + text >=0.10 && <1.3 || >= 2.0 && <2.1, + time >= 1.2 && <1.13, + transformers >= 0.2 && <0.7, + vector >= 0.7 && <0.14 + if !impl(ghc >= 7.8) + Build-depends: bytestring-builder >= 0.10 && <0.11 + if impl(ghc >= 7.2) other-extensions: Trustworthy + if flag(Zlib) + Exposed-modules: System.IO.Streams.Zlib + Build-depends: zlib-bindings >= 0.1 && <0.2 + cpp-options: -DENABLE_ZLIB + + if flag(Network) + Exposed-modules: System.IO.Streams.Network + Other-modules: System.IO.Streams.Internal.Network + Build-depends: network >= 2.3 && <3.2 + cpp-options: -DENABLE_NETWORK + other-extensions: BangPatterns, CPP, @@ -167,11 +197,9 @@ System.IO.Streams.Tests.Handle, System.IO.Streams.Tests.Internal, System.IO.Streams.Tests.List, - System.IO.Streams.Tests.Network, System.IO.Streams.Tests.Process, System.IO.Streams.Tests.Text, System.IO.Streams.Tests.Vector, - System.IO.Streams.Tests.Zlib, System.IO.Streams, System.IO.Streams.Attoparsec.ByteString, System.IO.Streams.Attoparsec.Text, @@ -184,47 +212,56 @@ System.IO.Streams.Handle, System.IO.Streams.File, System.IO.Streams.List, - System.IO.Streams.Network, System.IO.Streams.Process, System.IO.Streams.Text, System.IO.Streams.Vector, - System.IO.Streams.Zlib, System.IO.Streams.Internal, System.IO.Streams.Internal.Attoparsec, - System.IO.Streams.Internal.Network, System.IO.Streams.Internal.Search ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-do-bind - ghc-prof-options: -auto-all if !os(windows) && !flag(NoInteractiveTests) cpp-options: -DENABLE_PROCESS_TESTS - Build-depends: base >= 4 && <5, - attoparsec >= 0.10 && <0.14, - bytestring >= 0.9 && <0.11, - bytestring-builder >= 0.10 && <0.11, + if flag(Zlib) + Other-modules: System.IO.Streams.Tests.Zlib, + System.IO.Streams.Zlib + Build-depends: zlib-bindings, + zlib >= 0.5 && <0.7 + cpp-options: -DENABLE_ZLIB + + if flag(Network) + Other-modules: System.IO.Streams.Internal.Network, + System.IO.Streams.Network, + System.IO.Streams.Tests.Network + Build-depends: network + cpp-options: -DENABLE_NETWORK + + Build-depends: base, + attoparsec, + bytestring, deepseq >= 1.2 && <1.5, directory >= 1.1 && <2, filepath >= 1.2 && <2, mtl >= 2 && <3, - network >= 2.3 && <2.7, - primitive >= 0.2 && <0.7, - process >= 1.1 && <1.7, - text >= 0.10 && <1.3, - time >= 1.2 && <1.9, - transformers >= 0.2 && <0.6, - vector >= 0.7 && <0.13, - zlib-bindings >= 0.1 && <0.2, + primitive, + process, + text, + time, + transformers, + vector, HUnit >= 1.2 && <2, QuickCheck >= 2.3.0.2 && <3, test-framework >= 0.6 && <0.9, test-framework-hunit >= 0.2.7 && <0.4, - test-framework-quickcheck2 >= 0.2.12.1 && <0.4, - zlib >= 0.5 && <0.7 + test-framework-quickcheck2 >= 0.2.12.1 && <0.4 + + if !impl(ghc >= 7.8) + Build-depends: bytestring-builder if impl(ghc >= 7.2) other-extensions: Trustworthy diff --git a/src/System/IO/Streams.hs b/src/System/IO/Streams.hs --- a/src/System/IO/Streams.hs +++ b/src/System/IO/Streams.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} @@ -66,11 +67,15 @@ , module System.IO.Streams.Handle , module System.IO.Streams.File , module System.IO.Streams.List +#ifdef ENABLE_NETWORK , module System.IO.Streams.Network +#endif , module System.IO.Streams.Process , module System.IO.Streams.Text , module System.IO.Streams.Vector +#ifdef ENABLE_ZLIB , module System.IO.Streams.Zlib +#endif ) where ------------------------------------------------------------------------------ @@ -85,11 +90,15 @@ import System.IO.Streams.File import System.IO.Streams.Handle import System.IO.Streams.List +#ifdef ENABLE_NETWORK import System.IO.Streams.Network +#endif import System.IO.Streams.Process import System.IO.Streams.Text import System.IO.Streams.Vector +#ifdef ENABLE_ZLIB import System.IO.Streams.Zlib +#endif ------------------------------------------------------------------------------ -- $generator diff --git a/src/System/IO/Streams/ByteString.hs b/src/System/IO/Streams/ByteString.hs --- a/src/System/IO/Streams/ByteString.hs +++ b/src/System/IO/Streams/ByteString.hs @@ -61,7 +61,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Typeable (Typeable) -import Prelude hiding (read, lines, unlines, words, unwords) +import Prelude hiding (lines, read, unlines, unwords, words) ------------------------------------------------------------------------------ import System.IO.Streams.Combinators (filterM, intersperse, outputFoldM) import System.IO.Streams.Internal (InputStream (..), OutputStream, makeInputStream, makeOutputStream, read, unRead, write) @@ -272,6 +272,10 @@ -- -- * consecutive delimiters are not merged. -- +-- * if the input ends in the delimiter, a final empty string is /not/ +-- emitted. (/Since: 1.5.0.0. Previous versions had the opposite behaviour, +-- which was changed to match 'Prelude.lines'./) +-- -- Example: -- -- @ @@ -305,15 +309,9 @@ else do let !b' = S.unsafeDrop 1 b dl <- readIORef ref - - if S.null b' - then do - writeIORef ref ("" :) - return $ Just $! S.concat $ dl [a] - else do - writeIORef ref id - unRead b' is - return $ Just $! S.concat $ dl [a] + when (not $ S.null b') $ unRead b' is + writeIORef ref id + return $ Just $! S.concat $ dl [a] ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Combinators.hs b/src/System/IO/Streams/Combinators.hs --- a/src/System/IO/Streams/Combinators.hs +++ b/src/System/IO/Streams/Combinators.hs @@ -47,6 +47,7 @@ , zipWith , zipWithM , unzip + , contraunzip -- * Utility , intersperse @@ -748,6 +749,20 @@ let (a, b) = proj x modifyIORef buf (. (b:)) return $! Just a) + + +------------------------------------------------------------------------------ +-- | Given two 'OutputStream's, returns a new stream that "unzips" the tuples +-- being written, writing the two elements to the corresponding given streams. +-- +-- You can use this together with @'contramap' (\\ x -> (x, x))@ to "fork" a +-- stream into two. +-- +-- /Since: 1.5.2.0/ +contraunzip :: OutputStream a -> OutputStream b -> IO (OutputStream (a, b)) +contraunzip sink1 sink2 = makeOutputStream $ \ tuple -> do + write (fmap fst tuple) sink1 + write (fmap snd tuple) sink2 ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Concurrent.hs b/src/System/IO/Streams/Concurrent.hs --- a/src/System/IO/Streams/Concurrent.hs +++ b/src/System/IO/Streams/Concurrent.hs @@ -23,7 +23,7 @@ import Control.Monad (forM_) import Prelude hiding (read) ------------------------------------------------------------------------------ -import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read) +import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, nullInput, read) ------------------------------------------------------------------------------ @@ -60,9 +60,14 @@ -- produced stream does not yield end-of-stream until all of the input streams -- have finished. -- --- This traps exceptions in each concurrent thread and re-raises them in the --- current thread. +-- Any exceptions raised in one of the worker threads will be trapped and +-- re-raised in the current thread. +-- +-- If the supplied list is empty, `concurrentMerge` will return an empty +-- stream. (/Since: 1.5.0.1/) +-- concurrentMerge :: [InputStream a] -> IO (InputStream a) +concurrentMerge [] = nullInput concurrentMerge iss = do mv <- newEmptyMVar nleft <- newMVar $! length iss diff --git a/src/System/IO/Streams/Internal.hs b/src/System/IO/Streams/Internal.hs --- a/src/System/IO/Streams/Internal.hs +++ b/src/System/IO/Streams/Internal.hs @@ -442,37 +442,50 @@ ------------------------------------------------------------------------------ +#if MIN_VERSION_base(4,15,0) +ignoreOffset :: (a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint +ignoreOffset f a ptr _ n = f a ptr n +#else +ignoreOffset :: a -> a +ignoreOffset = id +#endif +{-# INLINE ignoreOffset #-} + +------------------------------------------------------------------------------ +-- | The offset argument is ignored if present. instance H.RawIO (InputStream ByteString) where - read is ptr n = read is >>= maybe (return 0) f - where - f s = S.unsafeUseAsCStringLen s $ \(cstr, l) -> do + read = ignoreOffset $ \is ptr n -> + let f s = S.unsafeUseAsCStringLen s $ \(cstr, l) -> do let c = min n l copyBytes ptr (castPtr cstr) c return $! c + in read is >>= maybe (return 0) f - readNonBlocking _ _ _ = unsupported - write _ _ _ = unsupported - writeNonBlocking _ _ _ = unsupported + readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported + write = ignoreOffset $ \_ _ _ -> unsupported + writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------ +-- | The offset argument is ignored if present. instance H.RawIO (OutputStream ByteString) where - read _ _ _ = unsupported - readNonBlocking _ _ _ = unsupported - write os ptr n = S.packCStringLen (castPtr ptr, n) >>= - flip write os . Just - writeNonBlocking _ _ _ = unsupported + read = ignoreOffset $ \_ _ _ -> unsupported + readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported + write = ignoreOffset $ \os ptr n -> S.packCStringLen (castPtr ptr, n) >>= + flip write os . Just + writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------ -- | Internal convenience synonym for a pair of input\/output streams. type StreamPair a = SP (InputStream a) (OutputStream a) +-- | The offset argument is ignored if present. instance H.RawIO (StreamPair ByteString) where - read (SP is _) ptr n = H.read is ptr n - readNonBlocking _ _ _ = unsupported - write (SP _ os) ptr n = H.write os ptr n - writeNonBlocking _ _ _ = unsupported + read (SP is _) = H.read is + readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported + write (SP _ os) = H.write os + writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Vector.hs b/src/System/IO/Streams/Vector.hs --- a/src/System/IO/Streams/Vector.hs +++ b/src/System/IO/Streams/Vector.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} -- | Vector conversions and utilities. @@ -29,7 +30,7 @@ import Control.Concurrent.MVar (modifyMVar, modifyMVar_, newMVar) import Control.Monad (liftM, (>=>)) import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Primitive (PrimState (..)) +import Control.Monad.Primitive (PrimState (..), RealWorld) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Vector.Generic (Vector (..)) import qualified Data.Vector.Generic as V @@ -38,7 +39,17 @@ import System.IO.Streams.Internal (InputStream, OutputStream, fromGenerator, yield) import qualified System.IO.Streams.Internal as S +#if MIN_VERSION_vector(0,13,0) +import Control.Monad.ST (stToIO) +#endif +basicUnsafeFreezeCompat :: Vector v a => V.Mutable v RealWorld a -> IO (v a) +#if MIN_VERSION_vector(0,13,0) +basicUnsafeFreezeCompat = stToIO . V.basicUnsafeFreeze +#else +basicUnsafeFreezeCompat = V.basicUnsafeFreeze +#endif + ------------------------------------------------------------------------------ -- | Transforms a vector into an 'InputStream' that yields each of the values -- in the vector in turn. @@ -77,7 +88,7 @@ -- | Like 'toVector', but allows control over how large the vector buffer is to -- start with. toVectorSized :: Vector v a => Int -> InputStream a -> IO (v a) -toVectorSized n = toMutableVectorSized n >=> V.basicUnsafeFreeze +toVectorSized n = toMutableVectorSized n >=> basicUnsafeFreezeCompat {-# INLINE toVectorSized #-} @@ -136,7 +147,7 @@ vectorOutputStreamSized :: Vector v c => Int -> IO (OutputStream c, IO (v c)) vectorOutputStreamSized n = do (os, flush) <- mutableVectorOutputStreamSized n - return $! (os, flush >>= V.basicUnsafeFreeze) + return $! (os, flush >>= basicUnsafeFreezeCompat) ------------------------------------------------------------------------------ @@ -291,7 +302,7 @@ Int -> (OutputStream a -> IO b) -> IO (v a) -outputToVectorSized n = outputToMutableVectorSized n >=> V.basicUnsafeFreeze +outputToVectorSized n = outputToMutableVectorSized n >=> basicUnsafeFreezeCompat {-# INLINE outputToVectorSized #-} diff --git a/test/System/IO/Streams/Tests/ByteString.hs b/test/System/IO/Streams/Tests/ByteString.hs --- a/test/System/IO/Streams/Tests/ByteString.hs +++ b/test/System/IO/Streams/Tests/ByteString.hs @@ -8,18 +8,12 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L -import Data.List hiding (lines, - takeWhile, unlines, - unwords, words) +import Data.List hiding (lines, takeWhile, unlines, unwords, words) import Data.Maybe (isJust) import Data.Monoid -import Prelude hiding (lines, read, - take, takeWhile, - unlines, unwords, - words) +import Prelude hiding (lines, read, take, takeWhile, unlines, unwords, words) import qualified Prelude -import System.IO.Streams hiding (filter, - intersperse, mapM_) +import System.IO.Streams hiding (filter, intersperse, mapM_) import System.IO.Streams.Tests.Common import System.Timeout import Test.Framework @@ -625,6 +619,8 @@ fromList ["th", "e\nquick\nbrown", "\n", "", "fox"] >>= lines >>= toList >>= assertEqual "lines" ["the", "quick", "brown", "fox"] fromList [] >>= lines >>= toList >>= assertEqual "empty lines" [] + fromList ["a\nb\nc\n"] >>= lines >>= toList + >>= assertEqual "ending in delimiter" ["a","b","c"] fromList ["ok", "cool"] >>= \is -> outputToList (\os -> unlines os >>= connect is) >>= diff --git a/test/System/IO/Streams/Tests/Combinators.hs b/test/System/IO/Streams/Tests/Combinators.hs --- a/test/System/IO/Streams/Tests/Combinators.hs +++ b/test/System/IO/Streams/Tests/Combinators.hs @@ -56,6 +56,7 @@ , testZipWith , testZipWithM , testUnzip + , testContraunzip , testTake , testDrop , testGive @@ -358,6 +359,26 @@ toList is3 >>= assertEqual "unzip2-a" (fst $ Prelude.unzip l) read is4 >>= assertEqual "unzip2-read-b" Nothing read is3 >>= assertEqual "unzip2-read" Nothing + + +------------------------------------------------------------------------------ +testContraunzip :: Test +testContraunzip = testProperty "combinators/contrazip" $ monadicIO $ forAllM arbitrary prop + where + prop :: [Int] -> PropertyM IO ( ) + prop xs = liftQ $ do + let ys = fmap show xs + xsStream <- fromList xs + ysStream <- fromList ys + (xsSink, getXs') <- listOutputStream + (ysSink, getYs') <- listOutputStream + xysStream <- zip xsStream ysStream + xysSink <- contraunzip xsSink ysSink + connect xysStream xysSink + xs' <- getXs' + ys' <- getYs' + assertEqual "numbers" xs xs' + assertEqual "strings" ys ys' ------------------------------------------------------------------------------ diff --git a/test/System/IO/Streams/Tests/Concurrent.hs b/test/System/IO/Streams/Tests/Concurrent.hs --- a/test/System/IO/Streams/Tests/Concurrent.hs +++ b/test/System/IO/Streams/Tests/Concurrent.hs @@ -47,7 +47,7 @@ chans inputs <- mapM Streams.chanToInput chans resultMVar <- newEmptyMVar - forkIO (Streams.concurrentMerge inputs >>= Streams.toList + _ <- forkIO (Streams.concurrentMerge inputs >>= Streams.toList >>= putMVar resultMVar) putMVar firstMVar 0 result <- takeMVar resultMVar diff --git a/test/System/IO/Streams/Tests/Handle.hs b/test/System/IO/Streams/Tests/Handle.hs --- a/test/System/IO/Streams/Tests/Handle.hs +++ b/test/System/IO/Streams/Tests/Handle.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Handle (tests) where @@ -148,13 +149,13 @@ is <- Streams.fromList ["foo", "bar", "baz" :: S.ByteString] (os, getList) <- Streams.listOutputStream let sp = Streams.SP is (os :: OutputStream S.ByteString) - expectExceptionH $ H.write is undefined undefined - expectExceptionH $ H.writeNonBlocking is undefined undefined + expectExceptionH $ withZeroOffset H.write is undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking is undefined undefined expectExceptionH $ H.flushWriteBuffer is undefined expectExceptionH $ H.flushWriteBuffer0 is undefined - expectExceptionH $ H.read os undefined undefined - expectExceptionH $ H.writeNonBlocking os undefined undefined + expectExceptionH $ withZeroOffset H.read os undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined expectExceptionH $ H.fillReadBuffer0 is undefined expectExceptionH $ H.fillReadBuffer0 os undefined @@ -168,17 +169,17 @@ H.devType os >>= assertBool "devtype output" . (== H.Stream) H.devType sp >>= assertBool "devtype pair" . (== H.Stream) - expectExceptionH $ H.readNonBlocking is undefined undefined - expectExceptionH $ H.readNonBlocking os undefined undefined - expectExceptionH $ H.readNonBlocking sp undefined undefined - expectExceptionH $ H.writeNonBlocking is undefined undefined - expectExceptionH $ H.writeNonBlocking os undefined undefined - expectExceptionH $ H.writeNonBlocking sp undefined undefined + expectExceptionH $ withZeroOffset H.readNonBlocking is undefined undefined + expectExceptionH $ withZeroOffset H.readNonBlocking os undefined undefined + expectExceptionH $ withZeroOffset H.readNonBlocking sp undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking is undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking sp undefined undefined S.useAsCStringLen "foo" $ \(cstr, l) -> do - H.write os (castPtr cstr) l + withZeroOffset H.write os (castPtr cstr) l liftM S.concat getList >>= assertEqual "H.write 1" "foo" - H.write sp (castPtr cstr) l + withZeroOffset H.write sp (castPtr cstr) l liftM S.concat getList >>= assertEqual "H.write 2" "foo" buf <- H.newBuffer sp HB.WriteBuffer HB.withBuffer buf $ \ptr -> copyBytes ptr (castPtr cstr) 3 @@ -189,10 +190,18 @@ allocaBytes 3 $ \buf -> do - l <- H.read is buf 3 + l <- withZeroOffset H.read is buf 3 assertEqual "3 byte read" 3 l S.packCStringLen (castPtr buf, l) >>= assertEqual "first read" "foo" - l' <- H.read sp buf 3 + l' <- withZeroOffset H.read sp buf 3 assertEqual "3 byte read #2" 3 l' S.packCStringLen (castPtr buf, l') >>= assertEqual "second read" "bar" - expectExceptionH $ H.read os buf 3 + expectExceptionH $ withZeroOffset H.read os buf 3 + where +#if MIN_VERSION_base(4,15,0) + withZeroOffset :: Num off => (a -> ptr -> off -> n -> ioint) -> a -> ptr -> n -> ioint + withZeroOffset f a ptr n = f a ptr 0 n +#else + withZeroOffset :: a -> a + withZeroOffset = id +#endif diff --git a/test/System/IO/Streams/Tests/Network.hs b/test/System/IO/Streams/Tests/Network.hs --- a/test/System/IO/Streams/Tests/Network.hs +++ b/test/System/IO/Streams/Tests/Network.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module System.IO.Streams.Tests.Network (tests) where @@ -13,6 +14,10 @@ import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) +#if MIN_VERSION_network(2,7,0) +#else +import Data.List (intercalate) +#endif ------------------------------------------------------------------------------ import qualified System.IO.Streams.Internal as Streams import qualified System.IO.Streams.Internal.Network as Streams @@ -32,10 +37,23 @@ assertEqual "ok" (Just ()) x where + -- compats +#if MIN_VERSION_network(2,7,0) + mkAddr = return . N.tupleToHostAddress + defaultPort = N.defaultPort + close = N.close + bind = N.bind +#else + mkAddr (o1,o2,o3,o4) = N.inet_addr . intercalate "." $ map show [o1,o2,o3,o4] + defaultPort = N.aNY_PORT + close = N.sClose + bind = N.bindSocket +#endif + go = do portMVar <- newEmptyMVar resultMVar <- newEmptyMVar - forkIO $ client portMVar resultMVar + _ <- forkIO $ client portMVar resultMVar server portMVar l <- takeMVar resultMVar assertEqual "testSocket" l ["ok"] @@ -43,28 +61,28 @@ client mvar resultMVar = do port <- takeMVar mvar sock <- N.socket N.AF_INET N.Stream N.defaultProtocol - addr <- N.inet_addr "127.0.0.1" + addr <- mkAddr (127, 0, 0, 1) let saddr = N.SockAddrInet port addr N.connect sock saddr (is, os) <- Streams.socketToStreams sock Streams.fromList ["", "ok"] >>= Streams.connectTo os N.shutdown sock N.ShutdownSend Streams.toList is >>= putMVar resultMVar - N.sClose sock + close sock server mvar = do sock <- N.socket N.AF_INET N.Stream N.defaultProtocol - addr <- N.inet_addr "127.0.0.1" - let saddr = N.SockAddrInet N.aNY_PORT addr - N.bindSocket sock saddr + addr <- mkAddr (127, 0, 0, 1) + let saddr = N.SockAddrInet defaultPort addr + bind sock saddr N.listen sock 5 port <- N.socketPort sock putMVar mvar port (csock, _) <- N.accept sock (is, os) <- Streams.socketToStreams csock Streams.toList is >>= flip Streams.writeList os - N.sClose csock - N.sClose sock + close csock + close sock testSocketWithError :: Test testSocketWithError = testCase "network/socket-error" $ N.withSocketsDo $ do diff --git a/test/TestSuite.hs b/test/TestSuite.hs --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Main where import qualified System.IO.Streams.Tests.Attoparsec.ByteString as AttoparsecByteString @@ -11,11 +13,15 @@ import qualified System.IO.Streams.Tests.Handle as Handle import qualified System.IO.Streams.Tests.Internal as Internal import qualified System.IO.Streams.Tests.List as List +#ifdef ENABLE_NETWORK import qualified System.IO.Streams.Tests.Network as Network +#endif import qualified System.IO.Streams.Tests.Process as Process import qualified System.IO.Streams.Tests.Text as Text import qualified System.IO.Streams.Tests.Vector as Vector +#ifdef ENABLE_ZLIB import qualified System.IO.Streams.Tests.Zlib as Zlib +#endif import Test.Framework (defaultMain, testGroup) @@ -34,9 +40,13 @@ , testGroup "Tests.Handle" Handle.tests , testGroup "Tests.Internal" Internal.tests , testGroup "Tests.List" List.tests +#ifdef ENABLE_NETWORK , testGroup "Tests.Network" Network.tests +#endif , testGroup "Tests.Process" Process.tests , testGroup "Tests.Text" Text.tests , testGroup "Tests.Vector" Vector.tests +#ifdef ENABLE_ZLIB , testGroup "Tests.Zlib" Zlib.tests +#endif ]