diff options
-rw-r--r-- | libraries/base/Data/Functor/Classes.hs | 5 | ||||
-rw-r--r-- | libraries/base/changelog.md | 2 | ||||
-rw-r--r-- | testsuite/tests/lib/base/T17472.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/lib/base/T17472.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/lib/base/all.T | 1 |
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, ['']) |