diff --git a/Control/Monad/BinaryProtocol/ZMQ.hs b/Control/Monad/BinaryProtocol/ZMQ.hs
--- a/Control/Monad/BinaryProtocol/ZMQ.hs
+++ b/Control/Monad/BinaryProtocol/ZMQ.hs
@@ -44,6 +44,10 @@
 -- | Take a @BinaryProtocol@ action and run it on the given ZeroMQ sockets for
 --   respectively reading and writing. The two given handles are allowed to be
 --   the same if the same handle is used for reading and writing.
+--
+--   Since ZeroMQ sockets are not thread-safe (unlike a Context object), make
+--   sure you use any socket you create in the OS thread it was created in
+--   only. Use @forkOS@ where necessary.
 runProtocol :: BinaryProtocol a b c -> ZMQ.Socket a -> ZMQ.Socket b -> IO c
 runProtocol p a b = R.runReaderT (runBP p) (a, b)
 
diff --git a/Test.hs b/Test.hs
--- a/Test.hs
+++ b/Test.hs
@@ -5,14 +5,11 @@
 import Test.Framework.Providers.HUnit
 import Test.HUnit
 
-import Control.Concurrent (forkIO)
+import Control.Concurrent (forkOS)
 import Control.Concurrent.MVar (MVar, newEmptyMVar, readMVar, putMVar)
 import Control.Exception (finally)
-import Control.Monad (forM_)
 import Control.Monad.Trans (liftIO)
 
-import System.IO (hPutStrLn, stderr)
-
 import qualified Data.Binary as B
 
 import qualified System.ZMQ as ZMQ
@@ -82,26 +79,47 @@
     resultMVar <- newEmptyMVar
 
     ctx <- ZMQ.init 1
-    (chan_in1, chan_out2) <- makeChannels ctx address1
-    (chan_in2, chan_out1) <- makeChannels ctx address2
 
-    forkIO $ runProtocol (protocol1 resultMVar) chan_in1 chan_out1
-    forkIO $ runProtocol (protocol2 resultMVar) chan_in2 chan_out2
+    lock1 <- newEmptyMVar
+    lock2 <- newEmptyMVar
 
-    result <- readMVar resultMVar `finally` do
-        forM_ [chan_in1, chan_in2] ZMQ.close
-        forM_ [chan_out1, chan_out2] ZMQ.close
-        ZMQ.term ctx
+    -- ZeroMQ sockets can only be used in the thread which created them.
+    -- We need some magic to get this right.
+    f $ forkOS $ runProtocol' address1 address2 ctx lock1 lock2
+        (protocol1 resultMVar)
+    f $ forkOS $ runProtocol' address2 address1 ctx lock2 lock1
+        (protocol2 resultMVar)
 
+    result <- readMVar resultMVar `finally` ZMQ.term ctx
+
     assertEqual "Was the correct result computed?" correct_result result
 
   where address1 = "inproc://pipe1"
         address2 = "inproc://pipe2"
 
+        f :: IO a -> IO ()
+        f a = a >> return ()
+
+        runProtocol' :: String -> String -> ZMQ.Context ->
+            MVar () -> MVar () ->
+            BinaryProtocol ZMQ.Up ZMQ.Down () -> IO ()
+        runProtocol' a1 a2 ctx l1 l2 p = do
+            chan_in <- ZMQ.socket ctx ZMQ.Up
+            chan_out <- ZMQ.socket ctx ZMQ.Down
+
+            ZMQ.bind chan_in a1
+            putMVar l1 ()
+
+            f $ readMVar l2
+            ZMQ.connect chan_out a2
+
+            runProtocol p chan_in chan_out `finally` do
+                ZMQ.close chan_in
+                ZMQ.close chan_out
+
+
 testAddition :: IO ()
-testAddition = do
-    hPutStrLn stderr
-        "Warning: this test locks up sometimes, needs investigation"
+testAddition =
     makeExchangeTest (3 :: Int)
         (\resultMVar -> do
              send (1 :: Int)
diff --git a/binary-protocol-zmq.cabal b/binary-protocol-zmq.cabal
--- a/binary-protocol-zmq.cabal
+++ b/binary-protocol-zmq.cabal
@@ -1,5 +1,5 @@
 Name:          binary-protocol-zmq
-Version:       0.1
+Version:       0.2
 Stability:     Experimental
 
 Synopsis:      Monad to ease implementing a binary network protocol over ZeroMQ