diff options
author | Ben Gamari <ben@smart-cactus.org> | 2022-06-12 20:39:47 -0400 |
---|---|---|
committer | Matthew Pickering <matthewtpickering@gmail.com> | 2022-06-20 09:25:19 +0100 |
commit | 4b12bd992addbef86e81dd8febf8bb2dcb84a015 (patch) | |
tree | 7ee48dc8d73b430bc9d582af8b3f455be0603cd0 | |
parent | 26745006bdecc2d269fd8252b189650d6bd7ac10 (diff) | |
download | haskell-wip/T21719.tar.gz |
testsuite: Add test for #21719wip/T21719
Happily, this has been fixed since 9.2.
-rw-r--r-- | testsuite/tests/partial-sigs/should_compile/T21719.hs | 31 | ||||
-rw-r--r-- | testsuite/tests/partial-sigs/should_compile/T21719.stderr | 35 | ||||
-rw-r--r-- | testsuite/tests/partial-sigs/should_compile/all.T | 1 |
3 files changed, 67 insertions, 0 deletions
diff --git a/testsuite/tests/partial-sigs/should_compile/T21719.hs b/testsuite/tests/partial-sigs/should_compile/T21719.hs new file mode 100644 index 0000000000..738b01746c --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T21719.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE BlockArguments #-} + +module T21719 where + +import Control.Exception + +data Foo = Foo + deriving (Show, Exception) + +class CanThrow e + +qux :: Monad m => (CanThrow Foo => m a) -> m a +qux _ = undefined + +class Monad m => MonadCheckedThrow m where + throwChecked :: (Exception e, CanThrow e) => e -> m a + +foo :: MonadCheckedThrow m => m Int +foo = do + qux do + _ <- baz + pure 5 + where + baz :: (CanThrow Foo, _) => _ + baz = throwChecked Foo + diff --git a/testsuite/tests/partial-sigs/should_compile/T21719.stderr b/testsuite/tests/partial-sigs/should_compile/T21719.stderr new file mode 100644 index 0000000000..944729e88a --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T21719.stderr @@ -0,0 +1,35 @@ + +T21719.hs:29:27: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found extra-constraints wildcard standing for + ‘MonadCheckedThrow m1’ + Where: ‘m1’ is a rigid type variable bound by + the inferred type of + baz :: (CanThrow Foo, MonadCheckedThrow m1) => m1 a + at T21719.hs:30:5-26 + • In the type signature: baz :: (CanThrow Foo, _) => _ + In an equation for ‘foo’: + foo + = do qux + do _ <- baz + .... + where + baz :: (CanThrow Foo, _) => _ + baz = throwChecked Foo + • Relevant bindings include foo :: m Int (bound at T21719.hs:24:1) + +T21719.hs:29:33: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘m1 a’ + Where: ‘m1’, ‘a’ are rigid type variables bound by + the inferred type of + baz :: (CanThrow Foo, MonadCheckedThrow m1) => m1 a + at T21719.hs:30:5-26 + • In the type signature: baz :: (CanThrow Foo, _) => _ + In an equation for ‘foo’: + foo + = do qux + do _ <- baz + .... + where + baz :: (CanThrow Foo, _) => _ + baz = throwChecked Foo + • Relevant bindings include foo :: m Int (bound at T21719.hs:24:1) diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index bb7c58a576..995e9723f6 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -102,4 +102,5 @@ test('T16762d', normal, compile, ['']) test('T14658', normal, compile, ['']) test('T18646', normal, compile, ['']) test('T20921', normal, compile, ['']) +test('T21719', normal, compile, ['']) test('InstanceGivenOverlap3', expect_broken(20076), compile, ['']) |