summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2023-01-17 08:07:48 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-01-18 22:26:03 -0500
commit154889dbfbef62ad58a28df4171bf767cc690c2a (patch)
tree0051568e5e922c2d20664d1bd910d71b79539b47
parentf058e3672b969f301b6b1637f8ab081654ec947a (diff)
downloadhaskell-154889dbfbef62ad58a28df4171bf767cc690c2a.tar.gz
Add regression test for #22151
Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151.
-rw-r--r--testsuite/tests/warnings/should_compile/T22151.hs16
-rw-r--r--testsuite/tests/warnings/should_compile/all.T1
2 files changed, 17 insertions, 0 deletions
diff --git a/testsuite/tests/warnings/should_compile/T22151.hs b/testsuite/tests/warnings/should_compile/T22151.hs
new file mode 100644
index 0000000000..aa30b07e5f
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T22151.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE UndecidableInstances #-}
+module T22151 where
+
+import Control.Monad.IO.Class (MonadIO(liftIO))
+
+class (Applicative m, Monad m) => C m where
+ m :: m ()
+
+-- This should not emit a -Wredundant-constraints warning. This is because
+-- GHC should not expand the superclasses of the Given constraint `MonadIO m`
+-- given that it is not Paterson-smaller than the instance head `C m`. (See
+-- Note [Recursive superclasses] in GHC.Tc.TyCl.Instance for more on what
+-- "Paterson-smaller" means.) As a result, we must provide the `Applicative m`
+-- and `Monad m` constraints explicitly.
+instance (Applicative m, Monad m, MonadIO m) => C m where
+ m = liftIO (pure ())
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index 3139a042e2..5a799ab885 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -53,4 +53,5 @@ test('DerivingTypeable', normal, compile, ['-Wderiving-typeable'])
test('T18862a', normal, compile, [''])
test('T18862b', normal, compile, [''])
test('T20312', normal, compile,['-Wall'])
+test('T22151', normal, compile, ['-Wredundant-constraints'])
test('T22759', normal, compile, [''])