summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2018-08-27 14:02:49 +0200
committerKrzysztof Gogolewski <krz.gogolewski@gmail.com>2018-08-27 14:03:34 +0200
commit7a3cda534d1447c813aa37cdd86e20b8d782cb02 (patch)
tree7f266adf199eb3c26a387bdd20357699c49dbe13
parent5e6cf2a9301a5473ff9c5319b96de941b1ad72dd (diff)
downloadhaskell-7a3cda534d1447c813aa37cdd86e20b8d782cb02.tar.gz
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
-rw-r--r--compiler/basicTypes/BasicTypes.hs14
-rw-r--r--testsuite/tests/th/T15502.hs9
-rw-r--r--testsuite/tests/th/T15502.stderr4
-rw-r--r--testsuite/tests/th/all.T1
4 files changed, 26 insertions, 2 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 93010b75f9..ce4696293c 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 0000000000..96800f8bc6
--- /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 0000000000..1177799775
--- /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 55724dc1d9..296cec7718 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -426,4 +426,5 @@ test('TH_rebindableAdo', normal, compile, [''])
test('T14627', normal, compile_fail, [''])
test('TH_invalid_add_top_decl', normal, compile_fail, [''])
test('T15550', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T15502', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])