-- | Tests for things that didn't work in the past.
module Main where
import Network.Socket
import Control.Exception
import Test.Framework (Test, defaultMain)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertFailure)
------------------------------------------------------------------------
-- Tests
-- Used to segfault on OS X 10.8.2 due to AI_NUMERICSERV being set
-- without a service being set. This is a OS X bug.
testGetAddrInfo :: IO ()
testGetAddrInfo = do
let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }
_ <- getAddrInfo (Just hints) (Just "localhost") Nothing
return ()
mkBadSocketAndTry :: (Socket -> IO a) -> IO (Either IOException a)
mkBadSocketAndTry f = do
sock <- socket AF_INET Stream defaultProtocol
try $ f sock
-- Because of 64/32 bitness issues, -1 wasn't correctly checked for on Windows.
-- See also GHC ticket #12010
badRecvShouldThrow :: IO ()
badRecvShouldThrow = do
res <- mkBadSocketAndTry $ flip recv 1024
case res of
Left _ex -> return ()
Right _ -> assertFailure "recv didn't throw an exception"
badSendShouldThrow :: IO ()
badSendShouldThrow = do
res <- mkBadSocketAndTry $ flip send "hello"
case res of
Left _ex -> return ()
Right _ -> assertFailure "send didn't throw an exception"
------------------------------------------------------------------------
-- List of all tests
tests :: [Test]
tests =
[ testCase "testGetAddrInfo" testGetAddrInfo
, testCase "badRecvShouldThrow" badRecvShouldThrow
, testCase "badSendShouldThrow" badSendShouldThrow
]
------------------------------------------------------------------------
-- Test harness
main :: IO ()
main = withSocketsDo $ defaultMain tests