diff options
4 files changed, 21 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index 30fe0cad44..38e400419a 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -397,7 +397,14 @@ tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) } tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside - = do { (rhs', rhs_ty) <- tcInferRhoNC rhs + = do { -- The Many on the next line and the unrestricted on the line after + -- are linked. These must be the same multiplicity. Consider + -- x <- rhs -> u + -- + -- The multiplicity of x in u must be the same as the multiplicity at + -- which the rhs has been consumed. When solving #18738, we want these + -- two multiplicity to still be the same. + (rhs', rhs_ty) <- tcScalingUsage Many $ tcInferRhoNC rhs -- Stmt has a context already ; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (unrestricted rhs_ty) $ diff --git a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs new file mode 100644 index 0000000000..be837fd80b --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +module LinearPatternGuardWildcard where + +-- See #18439 + +unsafeConsume :: a #-> () +unsafeConsume x | _ <- x = () diff --git a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr new file mode 100644 index 0000000000..466ad41862 --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr @@ -0,0 +1,5 @@ + +LinearPatternGuardWildcard.hs:7:15: error: + • Couldn't match type ‘'Many’ with ‘'One’ + arising from multiplicity of ‘x’ + • In an equation for ‘unsafeConsume’: unsafeConsume x | _ <- x = () diff --git a/testsuite/tests/linear/should_fail/all.T b/testsuite/tests/linear/should_fail/all.T index 67906053dc..941966673c 100644 --- a/testsuite/tests/linear/should_fail/all.T +++ b/testsuite/tests/linear/should_fail/all.T @@ -27,3 +27,4 @@ test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) +test('LinearPatternGuardWildcard', normal, compile_fail, ['']) |