[GHC] #4105: ffi005 fails on OS X

[GHC]

#4105: ffi005 fails on OS X
---------------------------------+------------------------------------------
    Reporter:  igloo             |        Owner:              
        Type:  bug               |       Status:  new         
    Priority:  normal            |    Milestone:  6.14.1      
   Component:  Compiler          |      Version:  6.12.2      
    Keywords:                    |   Difficulty:              
          Os:  MacOS X           |     Testcase:  ffi005      
Architecture:  Unknown/Multiple  |      Failure:  None/Unknown
---------------------------------+------------------------------------------
 The ffi005 test is failing on OS X x86.

 The test is only run the optc way, but we get other bad results when
 compiling in other ways.

 normal:
 {{{
 {-# LANGUAGE ForeignFunctionInterface #-}

 import Control.Monad
 import Foreign.C

 main :: IO ()
 main = doit sin mysin (encodeFloat 7926335344172077 (-54))

 doit :: (CDouble -> CDouble) -> (CDouble -> CDouble) -> CDouble -> IO ()
 doit f g x = do let fx = f x
                     gx = g x
                 when (fx /= gx) $ do print x
                                      print (decodeFloat x)
                                      print fx
                                      print gx
                                      print (fx - gx)

 foreign import ccall "sin" mysin :: CDouble -> CDouble
 }}}
 {{{
 $ ghc q.hs -o q; ./q
 0.4400000000000002
 (7926335344172077,-54)
 0.4259394650659998
 0.42593946506599983
 -5.551115123125783e-17
 }}}
 optc:
 {{{
 {-# LANGUAGE ForeignFunctionInterface #-}

 import Control.Monad
 import Foreign
 import Foreign.C

 main :: IO ()
 main = do sin_addr <- wrapId sin
           doit sin (dyn_sin sin_addr) (encodeFloat 7926335344172077 (-54))
           freeHaskellFunPtr sin_addr

 doit :: (CDouble -> CDouble) -> (CDouble -> CDouble) -> CDouble -> IO ()
 doit f g x = do let fx = f x
                     gx = g x
                 when (fx /= gx) $ do print x
                                      print (decodeFloat x)
                                      print fx
                                      print gx
                                      print (fx - gx)

 foreign import ccall "wrapper" wrapId :: (CDouble -> CDouble) -> IO
 (FunPtr (CDouble -> CDouble))
 foreign import ccall "dynamic" dyn_sin :: FunPtr (CDouble -> CDouble) ->
 (CDouble -> CDouble)
 }}}
 {{{
 $ ghc w.hs -o w -fvia-c -O; ./w
 0.4400000000000002
 (7926335344172077,-54)
 0.42593946506599983
 0.4259394650659998
 5.551115123125783e-17
 }}}
 optasm:
 {{{
 {-# LANGUAGE ForeignFunctionInterface #-}

 import Control.Monad
 import Foreign
 import Foreign.C

 main :: IO ()
 main = do sin_addr <- wrapId sin
           doit sin (dyn_sin sin_addr) (encodeFloat 7926335344172077 (-54))
           freeHaskellFunPtr sin_addr

 doit :: (CDouble -> CDouble) -> (CDouble -> CDouble) -> CDouble -> IO ()
 doit f g x = do let fx = f x
                     gx = g x
                 when (fx /= gx) $ do print x
                                      print (decodeFloat x)
                                      print fx
                                      print gx
                                      print (decodeFloat fx)
                                      print (decodeFloat gx)
                                      print (fx == gx)
                                      print (decodeFloat fx == decodeFloat
 gx)
                                      print (fx - gx)

 foreign import ccall "wrapper" wrapId :: (CDouble -> CDouble) -> IO
 (FunPtr (CDouble -> CDouble))
 foreign import ccall "dynamic" dyn_sin :: FunPtr (CDouble -> CDouble) ->
 (CDouble -> CDouble)
 }}}
 {{{
 $ ghc r.hs -o r -O; ./r
 0.4400000000000002
 (7926335344172077,-54)
 0.4259394650659998
 0.4259394650659998
 (7673043264614500,-54)
 (7673043264614500,-54)
 False
 True
 0.0
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/4105>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler