diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-01-03 14:07:46 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-01-03 14:12:41 -0500 |
| commit | a7f64c5ae502c29678f9fe14be33a758eb18c144 (patch) | |
| tree | c9448c79c5b1b68e723fa0df7bddd489ec38c48c | |
| parent | b73d862b932d08e286a1f0d2d087a0801e47c713 (diff) | |
| download | haskell-wip/T17633.tar.gz | |
typecheck: Fix #17633 by checking tycon in equation LHSwip/T17633
Issue #17633 point out that we fail to verify that the type constructor
in the LHS of a closed type family equantion matches the name of the
family. Fix this.
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 2 |
2 files changed, 9 insertions, 3 deletions
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 7fec6f4dd3..64798c94d7 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -3412,8 +3412,14 @@ checkValidTyCon tc | Just fam_flav <- famTyConFlav_maybe tc -> case fam_flav of { ClosedSynFamilyTyCon (Just ax) - -> tcAddClosedTypeFamilyDeclCtxt tc $ - checkValidCoAxiom ax + -> tcAddClosedTypeFamilyDeclCtxt tc $ do + -- Ensure that the TyCon in the equation matches + -- the tycon of the class head. See #17633. + checkTc (co_ax_tc tc == tc) + text "The type constructor" <+> ppr (co_ax_tc tc) <+> + text "in the LHS of the equation must match the family" <+> + text "name" <+> ppr tc <> text "." + checkValidCoAxiom tc ax ; ClosedSynFamilyTyCon Nothing -> return () ; AbstractClosedSynFamilyTyCon -> do { hsBoot <- tcIsHsBootOrSig diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 7c3763a364..0ee1d6c386 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -549,4 +549,4 @@ test('T17213', [extra_files(['T17213a.hs'])], multimod_compile_fail, ['T17213', test('T17355', normal, compile_fail, ['']) test('T17360', normal, compile_fail, ['']) test('T17563', normal, compile_fail, ['']) -test('T17633', expect_broken(17633), compile_fail, ['']) +test('T17633', normal, compile_fail, ['']) |