Fix some negation issues when creating FractionalLit

There were two different issues:

1. integralFractionalLit needed to be passed an already negated value. (T19680)
2. negateFractionalLit did not actually negate the argument, only
flipped the negation flag. (T19680A)

Fixes #19680

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, [''])