diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,6 +5,11 @@ This software currently has *beta* status, i.e. it had seen limited testing. +Version 0.8.2 - Revert changes to support 0MQ 2.x as well as 3.x in a single +package. Instead git branches will be used to track the various 0MQ versions +and a separate zeromq-haskell-3 library will be released to hackage. +Also this releases handles EINTR properly in socket option setting/getting. + Version 0.8.1 - zmqVersion has been renamed to version and reports the runtime version of 0MQ, instead of the compile time version macros. @@ -29,10 +34,6 @@ As usual for Haskell packages this software is installed best via Cabal (http://www.haskell.org/cabal). In addition to GHC it depends on 0MQ of course. -Please note that by default zeromq-haskell attempts to compile against 0MQ 2.x. -If instead you want to use 0MQ 3.x, then provide the following flags to Cabal: - - --flags="-zmq2 zmq3" Notes ----- diff --git a/src/System/ZMQ.hs b/src/System/ZMQ.hs --- a/src/System/ZMQ.hs +++ b/src/System/ZMQ.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ExistentialQuantification #-} +{-# LANGUAGE ExistentialQuantification #-} -- | -- Module : System.ZMQ -- Copyright : (c) 2010-2011 Toralf Wittner @@ -29,31 +29,19 @@ , Pair(..) , Pub(..) , Sub(..) -#ifdef ZMQ3 - , XPub(..) - , XSub(..) -#endif , Req(..) , Rep(..) , XReq(..) , XRep(..) , Pull(..) , Push(..) - -#ifdef ZMQ2 , Up(..) , Down(..) -#endif , withContext , withSocket , setOption , getOption - -#ifdef ZMQ3 - , getMsgOption -#endif - , System.ZMQ.subscribe , System.ZMQ.unsubscribe , bind @@ -71,10 +59,8 @@ , socket , close -#ifdef ZMQ2 , Device(..) , device -#endif ) where @@ -123,25 +109,6 @@ instance SType Sub where zmqSocketType = const sub -#ifdef ZMQ3 --- | Same as 'Pub' except that you can receive subscriptions from the --- peers in form of incoming messages. Subscription message is a byte 1 --- (for subscriptions) or byte 0 (for unsubscriptions) followed by the --- subscription body. --- /Compatible peer sockets/: 'Sub', 'XSub'. -data XPub = XPub -instance SType XPub where - zmqSocketType = const xpub - --- | Same as 'Sub' except that you subscribe by sending subscription --- messages to the socket. Subscription message is a byte 1 (for subscriptions) --- or byte 0 (for unsubscriptions) followed by the subscription body. --- /Compatible peer sockets/: 'Pub', 'XPub'. -data XSub = XSub -instance SType XSub where - zmqSocketType = const xsub -#endif - -- | Socket to send requests and receive replies. Requests are -- load-balanced among all the peers. This socket type allows only an -- alternated sequence of send's and recv's. @@ -200,7 +167,6 @@ instance SType Push where zmqSocketType = const push -#ifdef ZMQ2 {-# DEPRECATED Up "Use Pull instead." #-} -- | Socket to receive messages from up the stream. Messages are -- fair-queued from among all the connected peers. Send function is not @@ -216,15 +182,11 @@ data Down = Down instance SType Down where zmqSocketType = const downstream -#endif -- | Subscribable. class SubsType a instance SubsType Sub -#ifdef ZMQ3 -instance SubsType XSub -#endif -- | The option to set on 0MQ sockets (cf. zmq_setsockopt and zmq_getsockopt -- manpages for details). @@ -232,7 +194,7 @@ Affinity Word64 -- ^ ZMQ_AFFINITY | Backlog CInt -- ^ ZMQ_BACKLOG | Events PollEvent -- ^ ZMQ_EVENTS - | FD Int -- ^ ZMQ_FD + | FD CInt -- ^ ZMQ_FD | Identity String -- ^ ZMQ_IDENTITY | Linger CInt -- ^ ZMQ_LINGER | Rate Int64 -- ^ ZMQ_RATE @@ -242,28 +204,12 @@ | ReconnectIVLMax CInt -- ^ ZMQ_RECONNECT_IVL_MAX | RecoveryIVL Int64 -- ^ ZMQ_RECOVERY_IVL | SendBuf Word64 -- ^ ZMQ_SNDBUF -#ifdef ZMQ2 | HighWM Word64 -- ^ ZMQ_HWM | McastLoop Bool -- ^ ZMQ_MCAST_LOOP | RecoveryIVLMsec Int64 -- ^ ZMQ_RECOVERY_IVL_MSEC | Swap Int64 -- ^ ZMQ_SWAP -#endif -#ifdef ZMQ3 - | IPv4Only Bool -- ^ ZMQ_IPV4ONLY - | MaxMsgSize Int64 -- ^ ZMQ_MAXMSGSIZE - | McastHops Int -- ^ ZMQ_MULTICAST_HOPS - | ReceiveHighWM Int -- ^ ZMQ_RCVHWM - | ReceiveTimeout Int -- ^ ZMQ_RCVTIMEO - | SendHighWM Int -- ^ ZMQ_SNDHWM - | SendTimeout Int -- ^ ZMQ_SNDTIMEO -#endif deriving (Eq, Ord, Show) -#ifdef ZMQ3 -data MessageOption = MoreMsgParts CInt -- ^ ZMQ_MORE - deriving (Eq, Ord, Show) -#endif - -- | The events to wait for in poll (cf. man zmq_poll) data PollEvent = In -- ^ ZMQ_POLLIN (incoming messages) @@ -300,21 +246,10 @@ setOption s (ReconnectIVLMax o) = setIntOpt s reconnectIVLMax o setOption s (RecoveryIVL o) = setIntOpt s recoveryIVL o setOption s (SendBuf o) = setIntOpt s sendBuf o -#ifdef ZMQ2 setOption s (HighWM o) = setIntOpt s highWM o setOption s (McastLoop o) = setBoolOpt s mcastLoop o setOption s (RecoveryIVLMsec o) = setIntOpt s recoveryIVLMsec o setOption s (Swap o) = setIntOpt s swap o -#endif -#ifdef ZMQ3 -setOption s (IPv4Only o) = setBoolOpt s ipv4Only o -setOption s (MaxMsgSize o) = setIntOpt s maxMessageSize o -setOption s (McastHops o) = setIntOpt s mcastHops o -setOption s (ReceiveHighWM o) = setIntOpt s receiveHighWM o -setOption s (ReceiveTimeout o) = setIntOpt s receiveTimeout o -setOption s (SendHighWM o) = setIntOpt s sendHighWM o -setOption s (SendTimeout o) = setIntOpt s sendTimeout o -#endif -- | Get the given socket option by passing in some dummy value of -- that option. The actual value will be returned. Please note that @@ -334,25 +269,11 @@ getOption s (ReconnectIVLMax _) = ReconnectIVLMax <$> getIntOpt s reconnectIVLMax getOption s (RecoveryIVL _) = RecoveryIVL <$> getIntOpt s recoveryIVL getOption s (SendBuf _) = SendBuf <$> getIntOpt s sendBuf -#ifdef ZMQ2 getOption s (HighWM _) = HighWM <$> getIntOpt s highWM getOption s (McastLoop _) = McastLoop <$> getBoolOpt s mcastLoop getOption s (RecoveryIVLMsec _) = RecoveryIVLMsec <$> getIntOpt s recoveryIVLMsec getOption s (Swap _) = Swap <$> getIntOpt s swap -#endif -#ifdef ZMQ3 -getOption s (IPv4Only _) = IPv4Only <$> getBoolOpt s ipv4Only -getOption s (MaxMsgSize _) = MaxMsgSize <$> getIntOpt s maxMessageSize -getOption s (McastHops _) = McastHops <$> getIntOpt s mcastHops -getOption s (ReceiveHighWM _) = ReceiveHighWM <$> getIntOpt s receiveHighWM -getOption s (ReceiveTimeout _) = ReceiveTimeout <$> getIntOpt s receiveTimeout -getOption s (SendHighWM _) = SendHighWM <$> getIntOpt s sendHighWM -getOption s (SendTimeout _) = SendTimeout <$> getIntOpt s sendTimeout -getMsgOption :: Message -> MessageOption -> IO MessageOption -getMsgOption m (MoreMsgParts _) = MoreMsgParts <$> getIntMsgOpt m more -#endif - version :: IO (Int, Int, Int) version = with 0 $ \major_ptr -> @@ -373,7 +294,7 @@ -- | Terminate a 0MQ context (cf. zmq_term). You should normally -- prefer to use 'with' instead. term :: Context -> IO () -term = throwErrnoIfMinus1_ "term" . c_zmq_term . ctx +term = throwErrnoIfMinus1Retry_ "term" . c_zmq_term . ctx -- | Run an action with a 0MQ context. The 'Context' supplied to your -- action will /not/ be valid after the action either returns or @@ -381,7 +302,7 @@ withContext :: Size -> (Context -> IO a) -> IO a withContext ioThreads act = bracket (throwErrnoIfNull "c_zmq_init" $ c_zmq_init (fromIntegral ioThreads)) - (throwErrnoIfMinus1_ "c_zmq_term" . c_zmq_term) + (throwErrnoIfMinus1Retry_ "c_zmq_term" . c_zmq_term) (act . Context) -- | Run an action with a 0MQ socket. The socket will be closed after running @@ -516,7 +437,6 @@ waitRead = wait' threadWaitRead pollIn waitWrite = wait' threadWaitWrite pollOut -#ifdef ZMQ2 -- | Type representing ZeroMQ devices, as used with zmq_device data Device = Streamer -- ^ ZMQ_STREAMER @@ -538,4 +458,4 @@ fromDevice Streamer = fromIntegral . deviceType $ deviceStreamer fromDevice Forwarder = fromIntegral . deviceType $ deviceForwarder fromDevice Queue = fromIntegral . deviceType $ deviceQueue -#endif + diff --git a/src/System/ZMQ/Base.hsc b/src/System/ZMQ/Base.hsc --- a/src/System/ZMQ/Base.hsc +++ b/src/System/ZMQ/Base.hsc @@ -17,17 +17,8 @@ #include --- Ensure Cabal flag matches compile time version of 0MQ -#ifdef ZMQ2 #if ZMQ_VERSION_MAJOR != 2 - ERROR__ZMQ2_Flag_does_not_match_0MQ_Version -#endif -#endif - -#ifdef ZMQ3 -#if ZMQ_VERSION_MAJOR != 3 - ERROR__ZMQ3_Flag_does_not_match_0MQ_Version -#endif + ERROR__Invalid_0MQ_Version #endif newtype ZMQMsg = ZMQMsg { content :: Ptr () } @@ -35,14 +26,8 @@ instance Storable ZMQMsg where alignment _ = #{alignment zmq_msg_t} sizeOf _ = #{size zmq_msg_t} -#ifdef ZMQ2 peek p = ZMQMsg <$> #{peek zmq_msg_t, content} p poke p (ZMQMsg c) = #{poke zmq_msg_t, content} p c -#endif -#ifdef ZMQ3 - peek p = ZMQMsg <$> #{peek zmq_msg_t, _} p - poke p (ZMQMsg c) = #{poke zmq_msg_t, _} p c -#endif data ZMQPoll = ZMQPoll { pSocket :: ZMQSocket @@ -87,10 +72,8 @@ , xresponse = ZMQ_XREP , pull = ZMQ_PULL , push = ZMQ_PUSH -#ifdef ZMQ2 , upstream = ZMQ_UPSTREAM , downstream = ZMQ_DOWNSTREAM -#endif } newtype ZMQOption = ZMQOption { optVal :: CInt } deriving (Eq, Ord) @@ -111,45 +94,18 @@ , sendBuf = ZMQ_SNDBUF , subscribe = ZMQ_SUBSCRIBE , unsubscribe = ZMQ_UNSUBSCRIBE -#ifdef ZMQ2 , highWM = ZMQ_HWM , mcastLoop = ZMQ_MCAST_LOOP , recoveryIVLMsec = ZMQ_RECOVERY_IVL_MSEC , swap = ZMQ_SWAP -#endif -#ifdef ZMQ3 - , ipv4Only = ZMQ_IPV4ONLY - , maxMessageSize = ZMQ_MAXMSGSIZE - , mcastHops = ZMQ_MULTICAST_HOPS - , receiveHighWM = ZMQ_RCVHWM - , receiveTimeout = ZMQ_RCVTIMEO - , sendHighWM = ZMQ_SNDHWM - , sendTimeout = ZMQ_SNDTIMEO -#endif } -#ifdef ZMQ3 -newtype ZMQMsgOption = ZMQMsgOption { msgOptVal :: CInt } deriving (Eq, Ord) - -#{enum ZMQMsgOption, ZMQMsgOption - , more = ZMQ_MORE -} -#endif - newtype ZMQFlag = ZMQFlag { flagVal :: CInt } deriving (Eq, Ord) -#ifdef ZMQ2 #{enum ZMQFlag, ZMQFlag , noBlock = ZMQ_NOBLOCK , sndMore = ZMQ_SNDMORE } -#endif -#ifdef ZMQ3 -#{enum ZMQFlag, ZMQFlag - , noBlock = ZMQ_DONTWAIT - , sndMore = ZMQ_SNDMORE -} -#endif newtype ZMQPollEvent = ZMQPollEvent { pollVal :: CShort } deriving (Eq, Ord) @@ -160,8 +116,6 @@ pollInOut = ZMQ_POLLIN | ZMQ_POLLOUT } - -#ifdef ZMQ2 newtype ZMQDevice = ZMQDevice { deviceType :: CInt } deriving (Eq, Ord) #{enum ZMQDevice, ZMQDevice, @@ -172,7 +126,6 @@ foreign import ccall safe "zmq.h zmq_device" c_zmq_device :: CInt -> ZMQSocket -> ZMQSocket -> IO CInt -#endif -- general initialization @@ -231,27 +184,11 @@ c_zmq_connect :: ZMQSocket -> CString -> IO CInt -#ifdef ZMQ2 foreign import ccall unsafe "zmq.h zmq_send" c_zmq_send :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt foreign import ccall unsafe "zmq.h zmq_recv" c_zmq_recv :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt -#endif -#ifdef ZMQ3 -foreign import ccall unsafe "zmq.h zmq_sendmsg" - c_zmq_send :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt - -foreign import ccall unsafe "zmq.h zmq_recvmsg" - c_zmq_recv :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt - -foreign import ccall unsafe "zmq.h zmq_getmsgopt" - c_zmq_getmsgopt :: ZMQMsgPtr - -> CInt -- option - -> Ptr () -- option value - -> Ptr CSize -- option value size ptr - -> IO CInt -#endif -- poll diff --git a/src/System/ZMQ/Internal.hs b/src/System/ZMQ/Internal.hs --- a/src/System/ZMQ/Internal.hs +++ b/src/System/ZMQ/Internal.hs @@ -17,11 +17,6 @@ , getBoolOpt , getIntOpt , getStrOpt - -#ifdef ZMQ3 - , getIntMsgOpt -#endif - , toZMQFlag , combine , mkSocket @@ -121,14 +116,14 @@ setIntOpt :: (Storable b, Integral b) => Socket a -> ZMQOption -> b -> IO () setIntOpt sock (ZMQOption o) i = onSocket "setIntOpt" sock $ \s -> - throwErrnoIfMinus1_ "setIntOpt" $ with i $ \ptr -> + throwErrnoIfMinus1Retry_ "setIntOpt" $ with i $ \ptr -> c_zmq_setsockopt s (fromIntegral o) (castPtr ptr) (fromIntegral . sizeOf $ i) setStrOpt :: Socket a -> ZMQOption -> String -> IO () setStrOpt sock (ZMQOption o) str = onSocket "setStrOpt" sock $ \s -> - throwErrnoIfMinus1_ "setStrOpt" $ withCStringLen str $ \(cstr, len) -> + throwErrnoIfMinus1Retry_ "setStrOpt" $ withCStringLen str $ \(cstr, len) -> c_zmq_setsockopt s (fromIntegral o) (castPtr cstr) (fromIntegral len) @@ -141,7 +136,7 @@ let i = 0 bracket (new i) free $ \iptr -> bracket (new (fromIntegral . sizeOf $ i :: CSize)) free $ \jptr -> do - throwErrnoIfMinus1_ "getIntOpt" $ + throwErrnoIfMinus1Retry_ "getIntOpt" $ c_zmq_getsockopt s (fromIntegral o) (castPtr iptr) jptr peek iptr @@ -149,20 +144,9 @@ getStrOpt sock (ZMQOption o) = onSocket "getStrOpt" sock $ \s -> bracket (mallocBytes 255) free $ \bPtr -> bracket (new (255 :: CSize)) free $ \sPtr -> do - throwErrnoIfMinus1_ "getStrOpt" $ + throwErrnoIfMinus1Retry_ "getStrOpt" $ c_zmq_getsockopt s (fromIntegral o) (castPtr bPtr) sPtr peek sPtr >>= \len -> peekCStringLen (bPtr, fromIntegral len) - -#ifdef ZMQ3 -getIntMsgOpt :: (Storable a, Integral a) => Message -> ZMQMsgOption -> IO a -getIntMsgOpt (Message m) (ZMQMsgOption o) = do - let i = 0 - bracket (new i) free $ \iptr -> - bracket (new (fromIntegral . sizeOf $ i :: CSize)) free $ \jptr -> do - throwErrnoIfMinus1_ "getIntMsgOpt" $ - c_zmq_getmsgopt m (fromIntegral o) (castPtr iptr) jptr - peek iptr -#endif toZMQFlag :: Flag -> ZMQFlag toZMQFlag NoBlock = noBlock diff --git a/tests/System/ZMQ/Test/Properties.hs b/tests/System/ZMQ/Test/Properties.hs new file mode 100644 --- /dev/null +++ b/tests/System/ZMQ/Test/Properties.hs @@ -0,0 +1,108 @@ +module System.ZMQ.Test.Properties where + +import Control.Applicative +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 +import Test.QuickCheck +import Test.QuickCheck.Monadic + +import Data.Int +import Data.Word +import Data.ByteString (ByteString) +import qualified System.ZMQ as ZMQ +import qualified Data.ByteString as SB +import qualified Data.ByteString.Char8 as CB + +tests :: [Test] +tests = [ + testGroup "0MQ Socket Properties" [ + testProperty "get socket option (Push)" (prop_get_socket_option ZMQ.Push) + , testProperty "get socket option (Pull)" (prop_get_socket_option ZMQ.Pull) + , testProperty "get socket option (XRep)" (prop_get_socket_option ZMQ.XRep) + , testProperty "get socket option (XReq)" (prop_get_socket_option ZMQ.XReq) + , testProperty "get socket option (Rep)" (prop_get_socket_option ZMQ.Rep) + , testProperty "get socket option (Req)" (prop_get_socket_option ZMQ.Req) + , testProperty "get socket option (Sub)" (prop_get_socket_option ZMQ.Sub) + , testProperty "get socket option (Pub)" (prop_get_socket_option ZMQ.Pub) + , testProperty "get socket option (Pair)" (prop_get_socket_option ZMQ.Pair) + , testProperty "get socket option (Down)" (prop_get_socket_option ZMQ.Down) + , testProperty "get socket option (Up)" (prop_get_socket_option ZMQ.Up) + + , testProperty "set/get socket option (Push)" (prop_set_get_socket_option ZMQ.Push) + , testProperty "set/get socket option (Pull)" (prop_set_get_socket_option ZMQ.Pull) + , testProperty "set/get socket option (XRep)" (prop_set_get_socket_option ZMQ.XRep) + , testProperty "set/get socket option (XReq)" (prop_set_get_socket_option ZMQ.XReq) + , testProperty "set/get socket option (Rep)" (prop_set_get_socket_option ZMQ.Rep) + , testProperty "set/get socket option (Req)" (prop_set_get_socket_option ZMQ.Req) + , testProperty "set/get socket option (Sub)" (prop_set_get_socket_option ZMQ.Sub) + , testProperty "set/get socket option (Pub)" (prop_set_get_socket_option ZMQ.Pub) + , testProperty "set/get socket option (Pair)" (prop_set_get_socket_option ZMQ.Pair) + , testProperty "set/get socket option (Down)" (prop_set_get_socket_option ZMQ.Down) + , testProperty "set/get socket option (Up)" (prop_set_get_socket_option ZMQ.Up) + + , testProperty "(un-)subscribe" (prop_subscribe ZMQ.Sub) + ] + , testGroup "0MQ Messages" [ + testProperty "msg send == msg received (Req/Rep)" (prop_send_receive ZMQ.Req ZMQ.Rep) + , testProperty "msg send == msg received (Push/Pull)" (prop_send_receive ZMQ.Push ZMQ.Pull) + , testProperty "msg send == msg received (Pair/Pair)" (prop_send_receive ZMQ.Pair ZMQ.Pair) + ] + ] + +prop_get_socket_option :: ZMQ.SType a => a -> Property +prop_get_socket_option t = forAll readOnlyOptions canGetOption + where + canGetOption opt = monadicIO $ run $ + ZMQ.withContext 1 $ \c -> + ZMQ.withSocket c t $ \s -> ZMQ.getOption s opt + +prop_set_get_socket_option :: ZMQ.SType a => a -> ZMQ.SocketOption -> Property +prop_set_get_socket_option t opt = monadicIO $ do + o <- run $ ZMQ.withContext 1 $ \c -> + ZMQ.withSocket c t $ \s -> do + ZMQ.setOption s opt + ZMQ.getOption s opt + assert (opt == o) + +prop_subscribe :: (ZMQ.SubsType a, ZMQ.SType a) => a -> String -> Property +prop_subscribe t subs = monadicIO $ run $ + ZMQ.withContext 1 $ \c -> + ZMQ.withSocket c t $ \s -> do + ZMQ.subscribe s subs + ZMQ.unsubscribe s subs + +prop_send_receive :: (ZMQ.SType a, ZMQ.SType b) => a -> b -> ByteString -> Property +prop_send_receive a b msg = monadicIO $ do + msg' <- run $ ZMQ.withContext 0 $ \c -> + ZMQ.withSocket c a $ \sender -> + ZMQ.withSocket c b $ \receiver -> do + ZMQ.bind receiver "inproc://endpoint" + ZMQ.connect sender "inproc://endpoint" + ZMQ.send sender msg [] + ZMQ.receive receiver [] + assert (msg == msg') + +instance Arbitrary ZMQ.SocketOption where + arbitrary = oneof [ + ZMQ.Affinity . fromIntegral <$> (arbitrary :: Gen Word64) + , ZMQ.Backlog . fromIntegral <$> (arbitrary :: Gen Int32) + , ZMQ.Linger . fromIntegral <$> (arbitrary :: Gen Int32) + , ZMQ.Rate . fromIntegral <$> (arbitrary :: Gen Word32) + , ZMQ.ReceiveBuf . fromIntegral <$> (arbitrary :: Gen Word64) + , ZMQ.ReconnectIVL . fromIntegral <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) + , ZMQ.ReconnectIVLMax . fromIntegral <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) + , ZMQ.RecoveryIVL . fromIntegral <$> (arbitrary :: Gen Word32) + , ZMQ.RecoveryIVLMsec .fromIntegral <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) + , ZMQ.SendBuf . fromIntegral <$> (arbitrary :: Gen Word64) + , ZMQ.HighWM . fromIntegral <$> (arbitrary :: Gen Word64) + , ZMQ.McastLoop <$> (arbitrary :: Gen Bool) + , ZMQ.Swap . fromIntegral <$> (arbitrary :: Gen Int64) `suchThat` (>= 0) + , ZMQ.Identity . show <$> arbitrary `suchThat` (\s -> SB.length s > 0 && SB.length s < 255) + ] + +instance Arbitrary ByteString where + arbitrary = CB.pack <$> arbitrary + +readOnlyOptions :: Gen ZMQ.SocketOption +readOnlyOptions = elements [ZMQ.FD undefined, ZMQ.ReceiveMore undefined, ZMQ.Events undefined] + diff --git a/tests/tests.hs b/tests/tests.hs --- a/tests/tests.hs +++ b/tests/tests.hs @@ -1,112 +1,7 @@ -import Test.Framework (defaultMain, testGroup) -import Test.Framework (Test) -import Test.Framework.Providers.HUnit - -import qualified System.ZMQ as ZMQ +{-# LANGUAGE CPP #-} +import Test.Framework (defaultMain) +import qualified System.ZMQ.Test.Properties as Properties main :: IO () -main = defaultMain tests - -tests :: [Test] -tests = [ - testGroup "Misc" [ - testCase "ZMQ Context" test_context - ] - , testGroup "Socket Creation" [ - testCase "Push" (test_socket ZMQ.Push) - , testCase "Pull" (test_socket ZMQ.Pull) - , testCase "XRep" (test_socket ZMQ.XRep) - , testCase "XReq" (test_socket ZMQ.XReq) - , testCase "Rep" (test_socket ZMQ.Rep) - , testCase "Req" (test_socket ZMQ.Req) - , testCase "Sub" (test_socket ZMQ.Sub) - , testCase "Pub" (test_socket ZMQ.Pub) - , testCase "Pair" (test_socket ZMQ.Pair) ---ifdef ZMQ2 - , testCase "Down" (test_socket ZMQ.Down) - , testCase "Up" (test_socket ZMQ.Up) ---endif - ] - , testGroup "Socket Option (get)" [ - testCase "Affinity" (test_option_get (ZMQ.Affinity undefined)) - , testCase "Backlog" (test_option_get (ZMQ.Backlog undefined)) - , testCase "Events" (test_option_get (ZMQ.Events undefined)) - , testCase "FD" (test_option_get (ZMQ.FD undefined)) - , testCase "Identity" (test_option_get (ZMQ.Identity undefined)) - , testCase "Linger" (test_option_get (ZMQ.Linger undefined)) - , testCase "Rate" (test_option_get (ZMQ.Rate undefined)) - , testCase "ReceiveBuf" (test_option_get (ZMQ.ReceiveBuf undefined)) - , testCase "ReceiveMore" (test_option_get (ZMQ.ReceiveMore undefined)) - , testCase "ReconnectIVL" (test_option_get (ZMQ.ReconnectIVL undefined)) - , testCase "ReconnectIVLMax" (test_option_get (ZMQ.ReconnectIVLMax undefined)) - , testCase "ReconnectIVL" (test_option_get (ZMQ.RecoveryIVL undefined)) - , testCase "SendBuf" (test_option_get (ZMQ.SendBuf undefined)) ---ifdef ZMQ2 - , testCase "HighWM" (test_option_get (ZMQ.HighWM undefined)) - , testCase "McastLoop" (test_option_get (ZMQ.McastLoop undefined)) - , testCase "RecoveryIVLMsec" (test_option_get (ZMQ.RecoveryIVLMsec undefined)) - , testCase "Swap" (test_option_get (ZMQ.Swap undefined)) ---endif - ] - , testGroup "Socket Option (set)" [ - testCase "Affinity" (test_option_set (ZMQ.Affinity 0)) - , testCase "Backlog" (test_option_set (ZMQ.Backlog 100)) - , testCase "Events" (test_option_set (ZMQ.Events undefined)) - , testCase "FD" (test_option_set (ZMQ.FD undefined)) - , testCase "Identity" (test_option_set (ZMQ.Identity "id")) - , testCase "Linger" (test_option_set (ZMQ.Linger (-1))) - , testCase "Rate" (test_option_set (ZMQ.Rate 100)) - , testCase "ReceiveBuf" (test_option_set (ZMQ.ReceiveBuf 0)) - , testCase "ReceiveMore" (test_option_set (ZMQ.ReceiveMore undefined)) - , testCase "ReconnectIVL" (test_option_set (ZMQ.ReconnectIVL 100)) - , testCase "ReconnectIVLMax" (test_option_set (ZMQ.ReconnectIVLMax 0)) - , testCase "ReconnectIVL" (test_option_set (ZMQ.RecoveryIVL 100)) - , testCase "SendBuf" (test_option_set (ZMQ.SendBuf 0)) ---ifdef ZMQ2 - , testCase "HighWM" (test_option_set (ZMQ.HighWM 0)) - , testCase "McastLoop" (test_option_set (ZMQ.McastLoop True)) - , testCase "RecoveryIVLMsec" (test_option_set (ZMQ.RecoveryIVLMsec 10)) - , testCase "Swap" (test_option_set (ZMQ.Swap 0)) ---endif - ] - , testGroup "Pub/Sub" [ - testCase "Subscribe Sub" (test_subscribe ZMQ.Sub) - , testCase "Unsubscribe Sub" (test_unsubscribe ZMQ.Sub) - ] - ] - -test_context :: IO () -test_context = do - c1 <- ZMQ.init 1 - c2 <- ZMQ.init 3 - ZMQ.term c1 - ZMQ.term c2 - -test_socket :: ZMQ.SType a => a -> IO () -test_socket ty = - ZMQ.withContext 1 $ \c -> - ZMQ.socket c ty >>= ZMQ.close - -test_option_get :: ZMQ.SocketOption -> IO () -test_option_get o = - ZMQ.withContext 1 $ \c -> - ZMQ.withSocket c ZMQ.Sub $ \s -> - ZMQ.getOption s o >> return () - -test_option_set :: ZMQ.SocketOption -> IO () -test_option_set o = - ZMQ.withContext 1 $ \c -> - ZMQ.withSocket c ZMQ.Sub $ \s -> - ZMQ.setOption s o - -test_subscribe :: (ZMQ.SubsType a, ZMQ.SType a) => a -> IO () -test_subscribe ty = - ZMQ.withContext 1 $ \c -> - ZMQ.withSocket c ty $ \s -> - ZMQ.subscribe s "" +main = defaultMain Properties.tests -test_unsubscribe :: (ZMQ.SubsType a, ZMQ.SType a) => a -> IO () -test_unsubscribe ty = - ZMQ.withContext 1 $ \c -> - ZMQ.withSocket c ty $ \s -> - ZMQ.unsubscribe s "" diff --git a/zeromq-haskell.cabal b/zeromq-haskell.cabal --- a/zeromq-haskell.cabal +++ b/zeromq-haskell.cabal @@ -1,6 +1,6 @@ name: zeromq-haskell -version: 0.8.1 -synopsis: bindings to zeromq +version: 0.8.2 +synopsis: Bindings to ZeroMQ 2.1.x category: System, FFI license: MIT license-file: LICENSE @@ -17,6 +17,7 @@ , examples/*.hs , examples/perf/*.hs , tests/*.hs + , tests/System/ZMQ/Test/*.hs description: The 0MQ lightweight messaging kernel is a library which extends the standard socket interfaces with features traditionally provided @@ -26,16 +27,7 @@ multiple transport protocols and more. This library provides the Haskell language binding to 0MQ and - supports 0MQ 2.x as well as 3.x (use -fzmq2 or -fzmq3 to select - between the two). - -flag zmq2 - description: Compile with 0MQ 2.x - default: True - -flag zmq3 - description: Compile with 0MQ 3.x - default: False + supports 0MQ 2.1.x. library hs-source-dirs: src @@ -51,12 +43,6 @@ , containers , bytestring - if flag(zmq2) - cpp-options: -DZMQ2 - - if flag(zmq3) - cpp-options: -DZMQ3 - if os(freebsd) extra-libraries: zmq, pthread else @@ -71,9 +57,10 @@ , containers , bytestring , test-framework >= 0.4 - , test-framework-hunit >= 0.2 - , HUnit + , test-framework-quickcheck2 >= 0.2 + , QuickCheck >= 2.4 ghc-options: -Wall -threaded -rtsopts + cpp-options: -DZMQ2 source-repository head type: git