diff options
-rw-r--r-- | compiler/GHC/HsToCore/Match.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Types/SourceText.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/deSugar/should_run/T19680.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/deSugar/should_run/T19680.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/deSugar/should_run/T19680A.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/deSugar/should_run/T19680A.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/deSugar/should_run/all.T | 2 |
7 files changed, 30 insertions, 3 deletions
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs index d3b2776d93..6bd3860e42 100644 --- a/compiler/GHC/HsToCore/Match.hs +++ b/compiler/GHC/HsToCore/Match.hs @@ -1165,7 +1165,9 @@ patGroup _ (WildPat {}) = PgAny patGroup _ (BangPat {}) = PgBang patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = case (oval, isJust mb_neg) of - (HsIntegral i, is_neg) -> PgN (integralFractionalLit is_neg (il_value i)) + (HsIntegral i, is_neg) -> PgN (integralFractionalLit is_neg (if is_neg + then negate (il_value i) + else il_value i)) (HsFractional f, is_neg) | is_neg -> PgN $! negateFractionalLit f | otherwise -> PgN f diff --git a/compiler/GHC/Types/SourceText.hs b/compiler/GHC/Types/SourceText.hs index 59df5ddf9c..9faba4460b 100644 --- a/compiler/GHC/Types/SourceText.hs +++ b/compiler/GHC/Types/SourceText.hs @@ -222,10 +222,11 @@ mkTHFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double)) negateFractionalLit :: FractionalLit -> FractionalLit negateFractionalLit (FL text neg i e eb) = case text of - SourceText ('-':src) -> FL (SourceText src) False i e eb - SourceText src -> FL (SourceText ('-':src)) True i e eb + SourceText ('-':src) -> FL (SourceText src) False (negate i) e eb + SourceText src -> FL (SourceText ('-':src)) True (negate i) e eb NoSourceText -> FL NoSourceText (not neg) (negate i) e eb +-- | The integer should already be negated if it's negative. integralFractionalLit :: Bool -> Integer -> FractionalLit integralFractionalLit neg i = FL { fl_text = SourceText (show i) , fl_neg = neg @@ -233,6 +234,7 @@ integralFractionalLit neg i = FL { fl_text = SourceText (show i) , fl_exp = 0 , fl_exp_base = Base10 } +-- | The arguments should already be negated if they are negative. mkSourceFractionalLit :: String -> Bool -> Integer -> Integer -> FractionalExponentBase -> FractionalLit diff --git a/testsuite/tests/deSugar/should_run/T19680.hs b/testsuite/tests/deSugar/should_run/T19680.hs new file mode 100644 index 0000000000..881f10dde3 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T19680.hs @@ -0,0 +1,9 @@ +module Main where + +main :: IO () +main = do + let x = -1 :: Integer + print $ case x of + 1 -> "1" + -1 -> "-1" + _ -> "other" diff --git a/testsuite/tests/deSugar/should_run/T19680.stdout b/testsuite/tests/deSugar/should_run/T19680.stdout new file mode 100644 index 0000000000..5a03a99a88 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T19680.stdout @@ -0,0 +1 @@ +"-1" diff --git a/testsuite/tests/deSugar/should_run/T19680A.hs b/testsuite/tests/deSugar/should_run/T19680A.hs new file mode 100644 index 0000000000..45d2e86adf --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T19680A.hs @@ -0,0 +1,10 @@ +module Main where + +main :: IO () +main = do + let x = -1e3 :: Rational + print $ case x of + 1e3 -> "1" + -1e3 -> "-1" + _ -> "other" + diff --git a/testsuite/tests/deSugar/should_run/T19680A.stdout b/testsuite/tests/deSugar/should_run/T19680A.stdout new file mode 100644 index 0000000000..5a03a99a88 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T19680A.stdout @@ -0,0 +1 @@ +"-1" diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T index 9d43f94b40..c9ef02c074 100644 --- a/testsuite/tests/deSugar/should_run/all.T +++ b/testsuite/tests/deSugar/should_run/all.T @@ -71,3 +71,5 @@ test('T18172', [], ghci_script, ['T18172.script']) test('DsDoExprFailMsg', exit_code(1), compile_and_run, ['']) test('DsMonadCompFailMsg', exit_code(1), compile_and_run, ['']) test('T19289', normal, compile_and_run, ['']) +test('T19680', normal, compile_and_run, ['']) +test('T19680A', normal, compile_and_run, ['']) |