diff options
| -rw-r--r-- | compiler/basicTypes/BasicTypes.hs | 14 | ||||
| -rw-r--r-- | testsuite/tests/th/T15502.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/th/T15502.stderr | 4 | ||||
| -rw-r--r-- | 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 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']) |