[commit: ghc] ghc-8.6: Fix #15502 by not casting to Int during TH conversion (8344588)

[git at git.haskell.org]

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

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/8344588e23fc9bb3c1b15e81edd316134c9860ec/ghc

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

commit 8344588e23fc9bb3c1b15e81edd316134c9860ec
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Mon Aug 27 14:02:49 2018 +0200

    Fix #15502 by not casting to Int during TH conversion
    
    Summary:
    When turning an `IntegerL` to an `IntegralLit` during TH
    conversion, we were stupidly casting an `Integer` to an `Int` in
    order to determine how it should be pretty-printed. Unsurprisingly,
    this causes problems when the `Integer` doesn't lie within the bounds
    of an `Int`, as demonstrated in #15502.
    
    The fix is simple: don't cast to an `Int`.
    
    Test Plan: make test TEST=T15502
    
    Reviewers: bgamari, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: simonpj, rwbarton, carter
    
    GHC Trac Issues: #15502
    
    Differential Revision: https://phabricator.haskell.org/D5089
    
    (cherry picked from commit 7a3cda534d1447c813aa37cdd86e20b8d782cb02)


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

8344588e23fc9bb3c1b15e81edd316134c9860ec
 compiler/basicTypes/BasicTypes.hs | 14 ++++++++++++--
 testsuite/tests/th/T15502.hs      |  9 +++++++++
 testsuite/tests/th/T15502.stderr  |  4 ++++
 testsuite/tests/th/all.T          |  1 +
 4 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 93010b7..ce46962 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -1436,9 +1436,12 @@ data IntegralLit
   deriving (Data, Show)
 
 mkIntegralLit :: Integral a => a -> IntegralLit
-mkIntegralLit i = IL { il_text = SourceText (show (fromIntegral i :: Int))
+mkIntegralLit i = IL { il_text = SourceText (show i_integer)
                      , il_neg = i < 0
-                     , il_value = toInteger i }
+                     , il_value = i_integer }
+  where
+    i_integer :: Integer
+    i_integer = toInteger i
 
 negateIntegralLit :: IntegralLit -> IntegralLit
 negateIntegralLit (IL text neg value)
@@ -1463,6 +1466,13 @@ data FractionalLit
 
 mkFractionalLit :: Real a => a -> FractionalLit
 mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double))
+                           -- Converting to a Double here may technically lose
+                           -- precision (see #15502). We could alternatively
+                           -- convert to a Rational for the most accuracy, but
+                           -- it would cause Floats and Doubles to be displayed
+                           -- strangely, so we opt not to do this. (In contrast
+                           -- to mkIntegralLit, where we always convert to an
+                           -- Integer for the highest accuracy.)
                        , fl_neg = r < 0
                        , fl_value = toRational r }
 
diff --git a/testsuite/tests/th/T15502.hs b/testsuite/tests/th/T15502.hs
new file mode 100644
index 0000000..96800f8
--- /dev/null
+++ b/testsuite/tests/th/T15502.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T15502 where
+
+import Language.Haskell.TH.Syntax  (Lift(lift))
+
+main = print ( $( lift (toInteger (maxBound :: Int) + 1) )
+             , $( lift (minBound :: Int) )
+             )
diff --git a/testsuite/tests/th/T15502.stderr b/testsuite/tests/th/T15502.stderr
new file mode 100644
index 0000000..1177799
--- /dev/null
+++ b/testsuite/tests/th/T15502.stderr
@@ -0,0 +1,4 @@
+T15502.hs:7:19-56: Splicing expression
+    lift (toInteger (maxBound :: Int) + 1) ======> 9223372036854775808
+T15502.hs:8:19-40: Splicing expression
+    lift (minBound :: Int) ======> (-9223372036854775808)
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index ebdd2ce..fb62bd2 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -420,3 +420,4 @@ test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T15321', normal, compile_fail, [''])
 test('T15365', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T15502', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])