diff --git a/Network/BSD.hsc b/Network/BSD.hsc --- a/Network/BSD.hsc +++ b/Network/BSD.hsc @@ -112,12 +112,10 @@ import System.IO.Error (ioeSetErrorString, mkIOError) import System.IO.Unsafe (unsafePerformIO) -#ifdef __GLASGOW_HASKELL__ -# if __GLASGOW_HASKELL__ >= 611 +#if __GLASGOW_HASKELL__ >= 611 import GHC.IO.Exception -# else +#else import GHC.IOBase -# endif #endif import Control.Monad (liftM) diff --git a/Network/Socket.hsc b/Network/Socket.hsc --- a/Network/Socket.hsc +++ b/Network/Socket.hsc @@ -173,7 +173,7 @@ ) where import Data.Bits -import Data.List (foldl') +import Data.List (delete, foldl') import Data.Maybe (fromMaybe, isJust) import Data.Word (Word8, Word16, Word32) import Foreign.Ptr (Ptr, castPtr, nullPtr) @@ -199,7 +199,6 @@ import Data.Typeable import System.IO.Error -#ifdef __GLASGOW_HASKELL__ import GHC.Conc (threadWaitRead, threadWaitWrite) ##if MIN_VERSION_base(4,3,1) import GHC.Conc (closeFdWith) @@ -218,9 +217,6 @@ import GHC.Handle # endif import qualified System.Posix.Internals -#else -import System.IO.Unsafe (unsafePerformIO) -#endif # if __GLASGOW_HASKELL__ >= 611 import GHC.IO.FD @@ -498,7 +494,7 @@ else do let sz = sizeOfSockAddrByFamily family allocaBytes sz $ \ sockaddr -> do -#if defined(mingw32_HOST_OS) && defined(__GLASGOW_HASKELL__) +#if defined(mingw32_HOST_OS) new_sock <- if threaded then with (fromIntegral sz) $ \ ptr_len -> @@ -645,7 +641,7 @@ let len = length xs withCString xs $ \str -> do liftM fromIntegral $ -#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) # if __GLASGOW_HASKELL__ >= 611 writeRawBufferPtr "Network.Socket.send" @@ -677,7 +673,7 @@ -> IO Int -- Number of Bytes sent sendBuf sock@(MkSocket s _family _stype _protocol _status) str len = do liftM fromIntegral $ -#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) # if __GLASGOW_HASKELL__ >= 611 writeRawBufferPtr "Network.Socket.sendBuf" @@ -720,7 +716,7 @@ | otherwise = do allocaBytes nbytes $ \ptr -> do len <- -#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) # if __GLASGOW_HASKELL__ >= 611 readRawBufferPtr "Network.Socket.recvLen" (socket2FD sock) ptr 0 (fromIntegral nbytes) @@ -758,7 +754,7 @@ | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf") | otherwise = do len <- -#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) # if __GLASGOW_HASKELL__ >= 611 readRawBufferPtr "Network.Socket.recvLenBuf" (socket2FD sock) ptr 0 (fromIntegral nbytes) @@ -1183,7 +1179,7 @@ h <- fdToHandle' (fromIntegral fd) (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-} # elif __GLASGOW_HASKELL__ >= 608 h <- fdToHandle' (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} -# elif __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 608 +# elif __GLASGOW_HASKELL__ < 608 h <- openFd (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} # endif hSetBuffering h NoBuffering @@ -1305,9 +1301,6 @@ }) poke p (AddrInfo flags family socketType protocol _ _) = do -#if defined(darwin_HOST_OS) - zeroMemory p (#const sizeof(struct addrinfo)) -#endif c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags) @@ -1444,7 +1437,7 @@ getAddrInfo hints node service = maybeWith withCString node $ \c_node -> maybeWith withCString service $ \c_service -> - maybeWith with hints $ \c_hints -> + maybeWith with filteredHints $ \c_hints -> alloca $ \ptr_ptr_addrs -> do ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs case ret of @@ -1456,6 +1449,17 @@ ioError (ioeSetErrorString (mkIOError NoSuchThing "getAddrInfo" Nothing Nothing) err) + -- Leaving out the service and using AI_NUMERICSERV causes a + -- segfault on OS X 10.8.2. This code removes AI_NUMERICSERV + -- (which has no effect) in that case. + where +#if defined(darwin_HOST_OS) + filteredHints = case service of + Nothing -> fmap (\ h -> h { addrFlags = delete AI_NUMERICSERV (addrFlags h) }) hints + _ -> hints +#else + filteredHints = hints +#endif followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo] @@ -1561,11 +1565,7 @@ mkInvalidRecvArgError :: String -> IOError mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError -#ifdef __GLASGOW_HASKELL__ InvalidArgument -#else - IllegalOperation -#endif loc Nothing Nothing) "non-positive length" mkEOFError :: String -> IOError @@ -1609,7 +1609,7 @@ foreign import CALLCONV unsafe "listen" c_listen :: CInt -> CInt -> IO CInt -#if defined(mingw32_HOST_OS) && defined(__GLASGOW_HASKELL__) +#if defined(mingw32_HOST_OS) foreign import CALLCONV safe "accept" c_accept_safe :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt diff --git a/Network/Socket/ByteString.hsc b/Network/Socket/ByteString.hsc --- a/Network/Socket/ByteString.hsc +++ b/Network/Socket/ByteString.hsc @@ -79,16 +79,12 @@ import Network.Socket.ByteString.IOVec (IOVec(..)) import Network.Socket.ByteString.MsgHdr (MsgHdr(..)) -# if defined(__GLASGOW_HASKELL__) import GHC.Conc (threadWaitRead, threadWaitWrite) -# endif #else -# if defined(__GLASGOW_HASKELL__) -# if __GLASGOW_HASKELL__ >= 611 +# if __GLASGOW_HASKELL__ >= 611 import GHC.IO.FD -# else +# else import GHC.Handle (readRawBufferPtr, writeRawBufferPtr) -# endif # endif #endif @@ -111,7 +107,7 @@ send sock@(MkSocket s _ _ _ _) xs = unsafeUseAsCStringLen xs $ \(str, len) -> liftM fromIntegral $ -#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) # if __GLASGOW_HASKELL__ >= 611 writeRawBufferPtr "Network.Socket.ByteString.send" (FD s 1) (castPtr str) 0 (fromIntegral len) @@ -258,7 +254,7 @@ recvInner :: Socket -> Int -> Ptr Word8 -> IO Int recvInner sock nbytes ptr = fmap fromIntegral $ -#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) # if __GLASGOW_HASKELL__ >= 611 readRawBufferPtr "Network.Socket.ByteString.recv" (FD s 1) ptr 0 (fromIntegral nbytes) # else diff --git a/Network/Socket/ByteString/Internal.hs b/Network/Socket/ByteString/Internal.hs --- a/Network/Socket/ByteString/Internal.hs +++ b/Network/Socket/ByteString/Internal.hs @@ -34,21 +34,15 @@ import Network.Socket.ByteString.MsgHdr (MsgHdr) #endif -#ifdef __GLASGOW_HASKELL__ -# if __GLASGOW_HASKELL__ < 611 +#if __GLASGOW_HASKELL__ < 611 import GHC.IOBase (IOErrorType(..)) -# else +#else import GHC.IO.Exception (IOErrorType(..)) -# endif #endif mkInvalidRecvArgError :: String -> IOError mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError -#ifdef __GLASGOW_HASKELL__ InvalidArgument -#else - IllegalOperation -#endif loc Nothing Nothing) "non-positive length" #if !defined(mingw32_HOST_OS) diff --git a/Network/Socket/ByteString/Lazy.hsc b/Network/Socket/ByteString/Lazy.hsc --- a/Network/Socket/ByteString/Lazy.hsc +++ b/Network/Socket/ByteString/Lazy.hsc @@ -57,9 +57,7 @@ import qualified Data.ByteString.Lazy as L -# if defined(__GLASGOW_HASKELL__) import GHC.Conc (threadWaitWrite) -# endif #endif #if !defined(mingw32_HOST_OS) diff --git a/Network/Socket/Internal.hsc b/Network/Socket/Internal.hsc --- a/Network/Socket/Internal.hsc +++ b/Network/Socket/Internal.hsc @@ -88,12 +88,10 @@ #if defined(HAVE_WINSOCK2_H) && !defined(cygwin32_HOST_OS) import Control.Exception ( finally ) -# if __GLASGOW_HASKELL__ -# if __GLASGOW_HASKELL__ >= 707 +# if __GLASGOW_HASKELL__ >= 707 import GHC.IO.Exception ( IOErrorType(..) ) -# else +# else import GHC.IOBase ( IOErrorType(..) ) -# endif # endif import Foreign.C.Types ( CChar ) import System.IO.Error ( ioeSetErrorString, mkIOError ) @@ -150,7 +148,7 @@ {-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock :: String -> IO b -> IO CInt -> IO CInt #-} -#if defined(__GLASGOW_HASKELL__) && (!defined(HAVE_WINSOCK2_H) || defined(cygwin32_HOST_OS)) +#if (!defined(HAVE_WINSOCK2_H) || defined(cygwin32_HOST_OS)) throwSocketErrorIfMinus1RetryMayBlock name on_block act = throwErrnoIfMinus1RetryMayBlock name act on_block @@ -192,11 +190,7 @@ throwSocketErrorCode name rc = do pstr <- c_getWSError rc str <- peekCString pstr -# if __GLASGOW_HASKELL__ ioError (ioeSetErrorString (mkIOError OtherError name Nothing Nothing) str) -# else - ioError (userError (name ++ ": socket error - " ++ str)) -# endif throwSocketError name = c_getLastError >>= throwSocketErrorCode name @@ -214,7 +208,7 @@ throwSocketErrorCode loc errno = ioError (errnoToIOError loc (Errno errno) Nothing Nothing) # endif -#endif /* __GLASGOW_HASKELL */ +#endif -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with -- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready, diff --git a/Network/URI.hs b/Network/URI.hs --- a/Network/URI.hs +++ b/Network/URI.hs @@ -130,15 +130,11 @@ import Debug.Trace (trace) import Numeric (showIntAtBase) -#ifdef __GLASGOW_HASKELL__ import Data.Typeable (Typeable) -# if MIN_VERSION_base(4,0,0) +#if MIN_VERSION_base(4,0,0) import Data.Data (Data) -# else -import Data.Generics (Data) -# endif #else -import Data.Typeable (Typeable(..), TyCon, mkTyCon, mkTyConApp) +import Data.Generics (Data) #endif ------------------------------------------------------------ @@ -160,38 +156,14 @@ , uriPath :: String -- ^ @\/ghc@ , uriQuery :: String -- ^ @?query@ , uriFragment :: String -- ^ @#frag@ - } deriving (Eq, Ord -#ifdef __GLASGOW_HASKELL__ - , Typeable, Data -#endif - ) - -#ifndef __GLASGOW_HASKELL__ -uriTc :: TyCon -uriTc = mkTyCon "URI" - -instance Typeable URI where - typeOf _ = mkTyConApp uriTc [] -#endif + } deriving (Eq, Ord, Typeable, Data) -- |Type for authority value within a URI data URIAuth = URIAuth { uriUserInfo :: String -- ^ @anonymous\@@ , uriRegName :: String -- ^ @www.haskell.org@ , uriPort :: String -- ^ @:42@ - } deriving (Eq, Ord, Show -#ifdef __GLASGOW_HASKELL__ - , Typeable, Data -#endif - ) - -#ifndef __GLASGOW_HASKELL__ -uriAuthTc :: TyCon -uriAuthTc = mkTyCon "URIAuth" - -instance Typeable URIAuth where - typeOf _ = mkTyConApp uriAuthTc [] -#endif + } deriving (Eq, Ord, Show, Typeable, Data) -- |Blank URI nullURI :: URI diff --git a/network.cabal b/network.cabal --- a/network.cabal +++ b/network.cabal @@ -1,5 +1,5 @@ name: network -version: 2.4.1.1 +version: 2.4.1.2 license: BSD3 license-file: LICENSE maintainer: Johan Tibell @@ -69,6 +69,21 @@ network, test-framework, test-framework-hunit + +test-suite regression + hs-source-dirs: tests + main-is: Regression.hs + type: exitcode-stdio-1.0 + + build-depends: + base < 5, + bytestring, + HUnit, + network, + test-framework, + test-framework-hunit + + ghc-options: -Wall test-suite uri hs-source-dirs: tests diff --git a/tests/Regression.hs b/tests/Regression.hs new file mode 100644 --- /dev/null +++ b/tests/Regression.hs @@ -0,0 +1,31 @@ +-- | Tests for things that didn't work in the past. +module Main where + +import Network.Socket +import Test.Framework (Test, defaultMain) +import Test.Framework.Providers.HUnit (testCase) + +------------------------------------------------------------------------ +-- 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 () + +------------------------------------------------------------------------ +-- List of all tests + +tests :: [Test] +tests = + [ testCase "testGetAddrInfo" testGetAddrInfo + ] + +------------------------------------------------------------------------ +-- Test harness + +main :: IO () +main = withSocketsDo $ defaultMain tests