[GHC] #8089: Implementation of GHC.Event.Poll.poll is broken due to bad coercion

[GHC]

#8089: Implementation of GHC.Event.Poll.poll is broken due to bad coercion
-------------------------------------------+-------------------------------
       Reporter:  merijn                   |             Owner:
           Type:  bug                      |            Status:  new
       Priority:  normal                   |         Milestone:
      Component:  libraries/base           |           Version:  7.6.3
       Keywords:  patch                    |  Operating System:
   Architecture:  Unknown/Multiple         |  Unknown/Multiple
     Difficulty:  Easy (less than 1 hour)  |   Type of failure:  Runtime
     Blocked By:                           |  crash
Related Tickets:                           |         Test Case:
                                           |          Blocking:
-------------------------------------------+-------------------------------
 Due to an unsafe coercion in GHC.Event.Poll.poll the implementation has a
 bug that on some platforms (.e.g. linux) results in subtly wrong semantics
 and on other platforms (e.g. OS X) downright crashes the runtime.

 The offending line is line 95 in GHC/Event/Poll.hsc:
 {{{
 c_poll ptr (fromIntegral len) (fromIntegral (fromTimeout tout))
 }}}

 `fromTimeout` returns a timeout in seconds as a value of type Int.
 `c_poll` takes a timeout in seconds as a value of type CInt. If the max
 value of Int is larger than that of CInt, this coercion results in an
 overflow, producing a negative value. The faulty semantics are in turn
 caused by passing this negative value as timeout to `c_poll`.

 This overflow happens on many 64bit platforms where GHC's Int is 64bit,
 but CInt is often 32bit. The result of passing a negative value to poll()
 depends on the platform, but is (on all platforms I checked) different
 from the desired semantics!

 On linux any negative timeouts are treated as infinite, this means that a
 poll() with a timeout that should be finite results in an infinitely
 blocking poll on linux!

 On OSX any negative timeout other than -1 (which is treated as infinity)
 is considered an invalid parameter, returning an error and crashing the
 runtime.

 A minimal example reproducing the error (on systems where `fromIntegral
 (maxBound :: Int) > (fromIntegral (maxBound :: CInt) :: Integer)`):
 {{{
 import Control.Concurrent

 main = threadDelay maxBound
 }}}

 Using 64bit GHC on OSX this produces an immediate runtime crash.

 The attached patch solves the issue by comparing the Int timeout against
 the max value of CInt and, if necessary, looping multiple `c_poll` calls
 (with a timeout equal to `maxBound :: CInt`) if they return `0` (which
 indicates the timeout has expired with no events occurring).

 See also: https://github.com/merijn/packages-
 base/commit/6d8ea02a3f6a2cdb82a9ad786a8c4db780b92091

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