summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVaibhav Sagar <vaibhavsagar@gmail.com>2019-11-12 14:01:42 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-12-14 20:50:08 -0500
commit9ff54ea8260b1b1508a19e968eb4584cb5cef93c (patch)
tree3a656beeddb8a5c1c2e0e0d2ac72a82e6a5e6adb
parentc43ee6b81bd544ae338f9287a7b1edb646d51531 (diff)
downloadhaskell-9ff54ea8260b1b1508a19e968eb4584cb5cef93c.tar.gz
Data.Functor.Classes: fix Ord1 instance for Down
-rw-r--r--libraries/base/Data/Functor/Classes.hs5
-rw-r--r--libraries/base/changelog.md2
-rw-r--r--testsuite/tests/lib/base/T17472.hs8
-rw-r--r--testsuite/tests/lib/base/T17472.stdout1
-rw-r--r--testsuite/tests/lib/base/all.T1
5 files changed, 16 insertions, 1 deletions
diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs
index 2d119144ec..1bca124589 100644
--- a/libraries/base/Data/Functor/Classes.hs
+++ b/libraries/base/Data/Functor/Classes.hs
@@ -834,7 +834,10 @@ instance Eq1 Down where
-- | @since 4.12.0.0
instance Ord1 Down where
- liftCompare comp (Down x) (Down y) = comp x y
+ liftCompare comp (Down x) (Down y) = case comp x y of
+ LT -> GT
+ EQ -> EQ
+ GT -> LT
-- | @since 4.12.0.0
instance Read1 Down where
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 6c9bd23184..0bf4dc1ab7 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -33,6 +33,8 @@
have an HasCallStack constraint. Hopefully providing better error messages in case
they are used in unexpected ways.
+ * Fix the `Ord1` instance for `Data.Ord.Down` to reverse sort order.
+
## 4.16.0.0 *Nov 2021*
* The unary tuple type, `Solo`, is now exported by `Data.Tuple`.
diff --git a/testsuite/tests/lib/base/T17472.hs b/testsuite/tests/lib/base/T17472.hs
new file mode 100644
index 0000000000..cc4e9d6f35
--- /dev/null
+++ b/testsuite/tests/lib/base/T17472.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import Data.Ord
+import Data.Functor.Classes
+
+-- Should print GT
+main :: IO ()
+main = print $ compare1 (Down 1) (Down 2)
diff --git a/testsuite/tests/lib/base/T17472.stdout b/testsuite/tests/lib/base/T17472.stdout
new file mode 100644
index 0000000000..c81edbdc6a
--- /dev/null
+++ b/testsuite/tests/lib/base/T17472.stdout
@@ -0,0 +1 @@
+GT
diff --git a/testsuite/tests/lib/base/all.T b/testsuite/tests/lib/base/all.T
index e92af6d57c..3322f68a1c 100644
--- a/testsuite/tests/lib/base/all.T
+++ b/testsuite/tests/lib/base/all.T
@@ -5,3 +5,4 @@ test('T16916', when(opsys('mingw32'), skip), compile_and_run, ['-O2 -threaded -w
test('T17310', normal, compile, [''])
test('T19691', normal, compile, [''])
test('executablePath', extra_run_opts(config.os), compile_and_run, [''])
+test('T17472', normal, compile_and_run, [''])