[commit: ghc] wip/T10246: Ensure that Literals in an Int# case are in range (4870e52)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T10246
Link       : http://ghc.haskell.org/trac/ghc/changeset/4870e5259ca8669c095defaf692d8e498489604f/ghc

>---------------------------------------------------------------

commit 4870e5259ca8669c095defaf692d8e498489604f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon Apr 6 10:31:02 2015 +0200

    Ensure that Literals in an Int# case are in range
    
    This is one way to fix #10246. Three questions:
     * Can we rely on the target information in dflags this way?
     * Where should the to{Int,Word}{,64}Range functions live?
     * Should the clamping be moved from hsLitKey to mkMach*, effectively
       introducing a new invariant for the Mach* values?


>---------------------------------------------------------------

4870e5259ca8669c095defaf692d8e498489604f
 compiler/deSugar/MatchLit.hs             |  8 ++++----
 compiler/main/DynFlags.hs                | 24 ++++++++++++++++++++++++
 testsuite/tests/codeGen/should_run/all.T |  4 ++--
 3 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index 25021f5..22f7e66 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -382,10 +382,10 @@ hsLitKey :: DynFlags -> HsLit -> Literal
 --      (and doesn't for strings)
 -- It only works for primitive types and strings;
 -- others have been removed by tidy
-hsLitKey dflags (HsIntPrim    _ i) = mkMachInt  dflags i
-hsLitKey dflags (HsWordPrim   _ w) = mkMachWord dflags w
-hsLitKey _      (HsInt64Prim  _ i) = mkMachInt64  i
-hsLitKey _      (HsWord64Prim _ w) = mkMachWord64 w
+hsLitKey dflags (HsIntPrim    _ i) = mkMachInt  dflags (toIntRange dflags i)
+hsLitKey dflags (HsWordPrim   _ w) = mkMachWord dflags (toWordRange dflags w)
+hsLitKey dflags (HsInt64Prim  _ i) = mkMachInt64       (toInt64Range dflags i)
+hsLitKey dflags (HsWord64Prim _ w) = mkMachWord64      (toWord64Range dflags w)
 hsLitKey _      (HsCharPrim   _ c) = MachChar   c
 hsLitKey _      (HsStringPrim _ s) = MachStr    s
 hsLitKey _      (HsFloatPrim    f) = MachFloat  (fl_value f)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0dc25e3..2c599cd 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -130,6 +130,7 @@ module DynFlags (
         tAG_MASK,
         mAX_PTR_TAG,
         tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,
+        toIntRange, toInt64Range, toWordRange, toWord64Range,
 
         unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
 
@@ -4130,6 +4131,29 @@ tARGET_MAX_WORD dflags
       8 -> toInteger (maxBound :: Word64)
       w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w)
 
+toIntRange :: DynFlags -> Integer -> Integer
+toIntRange dflags i
+    = case platformWordSize (targetPlatform dflags) of
+      4 -> toInteger (fromIntegral i :: Int32)
+      8 -> toInteger (fromIntegral i :: Int64)
+      w -> panic ("toIntRange: Unknown platformWordSize: " ++ show w)
+
+toInt64Range :: DynFlags -> Integer -> Integer
+toInt64Range _dflags i -- DynFlags parameter just for consistency
+    = toInteger (fromIntegral i :: Int64)
+
+toWordRange :: DynFlags -> Integer -> Integer
+toWordRange dflags i
+    = case platformWordSize (targetPlatform dflags) of
+      4 -> toInteger (fromIntegral i :: Word32)
+      8 -> toInteger (fromIntegral i :: Word64)
+      w -> panic ("toWordRange: Unknown platformWordSize: " ++ show w)
+
+toWord64Range :: DynFlags -> Integer -> Integer
+toWord64Range _dflags i -- DynFlags parameter just for consistency
+    = toInteger (fromIntegral i :: Word64)
+
+
 -- Whenever makeDynFlagsConsistent does anything, it starts over, to
 -- ensure that a later change doesn't invalidate an earlier check.
 -- Be careful not to introduce potential loops!
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 41d18e5..e44e98a 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -128,5 +128,5 @@ test('T9013', omit_ways(['ghci']),  # ghci doesn't support unboxed tuples
 test('T9340', normal, compile_and_run, [''])
 test('cgrun074', normal, compile_and_run, [''])
 test('CmmSwitchTest', when(fast(), skip), compile_and_run, [''])
-test('T10245', expect_broken(10246), compile_and_run, [''])
-test('T10246', expect_broken(10246), compile_and_run, [''])
+test('T10245', normal, compile_and_run, [''])
+test('T10246', normal, compile_and_run, [''])