Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/306ab5509fceb5ccaf62222f94fe18b92ae6b476 >--------------------------------------------------------------- commit 306ab5509fceb5ccaf62222f94fe18b92ae6b476 Author: Simon Marlow <marlo...@gmail.com> Date: Tue Jul 31 09:06:43 2012 +0100 Fix #7087 (integer overflow in getDelayTarget()) MERGED from commit 598ee1ad1b8de089a2ed207543761d617a90db52 >--------------------------------------------------------------- includes/Rts.h | 2 ++ rts/posix/Select.c | 15 ++++++++++++--- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/includes/Rts.h b/includes/Rts.h index 501b9dc..c52fe63 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -156,6 +156,8 @@ void _assertFail(const char *filename, unsigned int linenum) #define TIME_RESOLUTION 1000000000 typedef StgInt64 Time; +#define TIME_MAX HS_INT64_MAX + #if TIME_RESOLUTION == 1000000000 // I'm being lazy, but it's awkward to define fully general versions of these #define TimeToUS(t) ((t) / 1000) diff --git a/rts/posix/Select.c b/rts/posix/Select.c index 1fb27d1..3d92a46 100644 --- a/rts/posix/Select.c +++ b/rts/posix/Select.c @@ -67,9 +67,18 @@ static LowResTime getLowResTimeOfDay(void) */ LowResTime getDelayTarget (HsInt us) { - // round up the target time, because we never want to sleep *less* - // than the desired amount. - return TimeToLowResTimeRoundUp(getProcessElapsedTime() + USToTime(us)); + Time elapsed; + elapsed = getProcessElapsedTime(); + + // If the desired target would be larger than the maximum Time, + // default to the maximum Time. (#7087) + if (us > TimeToUS(TIME_MAX - elapsed)) { + return TimeToLowResTimeRoundDown(TIME_MAX); + } else { + // round up the target time, because we never want to sleep *less* + // than the desired amount. + return TimeToLowResTimeRoundUp(elapsed + USToTime(us)); + } } /* There's a clever trick here to avoid problems when the time wraps _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
