diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index d313a844f591d82c3da8397985d21584e88e3c7b..79bf0be072aadfe960763c929aa1e3e4e048cf1c 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -4129,19 +4129,15 @@ data TcRnMessage where corresponding to a required type argument (visible forall) does not have a form that can be interpreted as a type pattern. - At the moment, only patterns constructed using the @type@ keyword - are considered well-formed, but this restriction will be relaxed - when part 2 of GHC Proposal #281 is implemented. - Example: vfun :: forall (a :: k) -> () - vfun x = () - -- ^ - -- expected `type x` instead of `x` + vfun !x = () + -- ^^ + -- bang-patterns not allowed as type patterns Test cases: - T22326_fail_raw_pat + T22326_fail_bang_pat -} TcRnIllformedTypePattern :: !(Pat GhcRn) -> TcRnMessage @@ -4173,7 +4169,7 @@ data TcRnMessage where -- lambdas not allowed in type arguments Test cases: - T22326_fail_raw_arg + T22326_fail_lam_arg -} TcRnIllformedTypeArgument :: !(LHsExpr GhcRn) -> TcRnMessage diff --git a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_pat.hs b/testsuite/tests/vdq-rta/should_fail/T22326_fail_bang_pat.hs similarity index 69% rename from testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_pat.hs rename to testsuite/tests/vdq-rta/should_fail/T22326_fail_bang_pat.hs index 97aba2a08e7d64568209624e8fe37b51104238f4..686758331558d5687e6b67d1b34143000797adac 100644 --- a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_pat.hs +++ b/testsuite/tests/vdq-rta/should_fail/T22326_fail_bang_pat.hs @@ -1,6 +1,6 @@ {-# LANGUAGE RequiredTypeArguments #-} -module T22326_fail_raw_pat where +module T22326_fail_bang_pat where f :: forall (a :: k) -> () f !x = () \ No newline at end of file diff --git a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_pat.stderr b/testsuite/tests/vdq-rta/should_fail/T22326_fail_bang_pat.stderr similarity index 69% rename from testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_pat.stderr rename to testsuite/tests/vdq-rta/should_fail/T22326_fail_bang_pat.stderr index 7cdc761f839a4cd45b045adaf23c0c24702a2e81..102e790b908d1d50e8a6fb5875ce03e1c99f12d5 100644 --- a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_pat.stderr +++ b/testsuite/tests/vdq-rta/should_fail/T22326_fail_bang_pat.stderr @@ -1,5 +1,5 @@ -T22326_fail_raw_pat.hs:6:3: error: [GHC-88754] +T22326_fail_bang_pat.hs:6:3: error: [GHC-88754] • Ill-formed type pattern: !x • In the pattern: !x In an equation for ‘f’: f !x = () diff --git a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_arg.hs b/testsuite/tests/vdq-rta/should_fail/T22326_fail_lam_arg.hs similarity index 80% rename from testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_arg.hs rename to testsuite/tests/vdq-rta/should_fail/T22326_fail_lam_arg.hs index 519194599c63692882b6d71a2e132aa590b9aa26..a1a4577a94d305dd6d1b9484569657a524e03c0e 100644 --- a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_arg.hs +++ b/testsuite/tests/vdq-rta/should_fail/T22326_fail_lam_arg.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE RequiredTypeArguments #-} -module T22326_fail_raw_arg where +module T22326_fail_lam_arg where f :: forall (a :: k) -> () f (type _) = () diff --git a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_arg.stderr b/testsuite/tests/vdq-rta/should_fail/T22326_fail_lam_arg.stderr similarity index 74% rename from testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_arg.stderr rename to testsuite/tests/vdq-rta/should_fail/T22326_fail_lam_arg.stderr index b46cb56edf5e71100820c96e3be1f6edc73b3914..c26605aaa6283dcf27fec94a2c805eaae8482e50 100644 --- a/testsuite/tests/vdq-rta/should_fail/T22326_fail_raw_arg.stderr +++ b/testsuite/tests/vdq-rta/should_fail/T22326_fail_lam_arg.stderr @@ -1,5 +1,5 @@ -T22326_fail_raw_arg.hs:9:5: error: [GHC-29092] +T22326_fail_lam_arg.hs:9:5: error: [GHC-29092] • Ill-formed type argument: \ _ -> _ • In the expression: f (\ _ -> _) In an equation for ‘x’: x = f (\ _ -> _) diff --git a/testsuite/tests/vdq-rta/should_fail/all.T b/testsuite/tests/vdq-rta/should_fail/all.T index f9cf1fe1ab60542acc2bc29b6a9851e7dcb44505..a0811d4de85bc7f4241bb08c2ac830ebbaef60f7 100644 --- a/testsuite/tests/vdq-rta/should_fail/all.T +++ b/testsuite/tests/vdq-rta/should_fail/all.T @@ -3,8 +3,8 @@ test('T22326_fail_ext2', normal, compile_fail, ['']) test('T22326_fail_top', normal, compile_fail, ['']) test('T22326_fail_app', normal, compile_fail, ['']) test('T22326_fail_notInScope', normal, compile_fail, ['']) -test('T22326_fail_raw_pat', normal, compile_fail, ['']) -test('T22326_fail_raw_arg', normal, compile_fail, ['']) +test('T22326_fail_bang_pat', normal, compile_fail, ['']) +test('T22326_fail_lam_arg', normal, compile_fail, ['']) test('T22326_fail_pat', normal, compile_fail, ['']) test('T22326_fail_nonlinear', normal, compile_fail, ['']) test('T22326_fail_caseof', normal, compile_fail, [''])