Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

30 changed files:

Changes:

  • compiler/GHC/Driver/Flags.hs
    ... ... @@ -1364,7 +1364,6 @@ standardWarnings -- see Note [Documenting warning flags]
    1364 1364
             Opt_WarnBadlyLevelledTypes,
    
    1365 1365
             Opt_WarnTypeEqualityRequiresOperators,
    
    1366 1366
             Opt_WarnInconsistentFlags,
    
    1367
    -        Opt_WarnDataKindsTC,
    
    1368 1367
             Opt_WarnTypeEqualityOutOfScope,
    
    1369 1368
             Opt_WarnImplicitRhsQuantification, -- was in -Wcompat since 9.8, enabled by default since 9.14, to turn into a hard error in 9.16
    
    1370 1369
             Opt_WarnViewPatternSignatures,
    

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -2382,7 +2382,8 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of
    2382 2382
       Opt_WarnImplicitRhsQuantification -> warnSpec x
    
    2383 2383
       Opt_WarnIncompleteExportWarnings -> warnSpec x
    
    2384 2384
       Opt_WarnIncompleteRecordSelectors -> warnSpec x
    
    2385
    -  Opt_WarnDataKindsTC -> warnSpec x
    
    2385
    +  Opt_WarnDataKindsTC
    
    2386
    +    -> depWarnSpec x "DataKinds violations are now always an error"
    
    2386 2387
       Opt_WarnDefaultedExceptionContext -> warnSpec x
    
    2387 2388
       Opt_WarnViewPatternSignatures -> warnSpec x
    
    2388 2389
       Opt_WarnUselessSpecialisations -> warnSpec x
    

  • compiler/GHC/Tc/Errors/Ppr.hs
    ... ... @@ -1750,21 +1750,15 @@ instance Diagnostic TcRnMessage where
    1750 1750
                     , inHsDocContext doc ]
    
    1751 1751
     
    
    1752 1752
         TcRnDataKindsError typeOrKind thing
    
    1753
    -      -- See Note [Checking for DataKinds] (Wrinkle: Migration story for
    
    1754
    -      -- DataKinds typechecker errors) in GHC.Tc.Validity for why we give
    
    1755
    -      -- different diagnostic messages below.
    
    1756 1753
           -> case thing of
    
    1757 1754
                Left renamer_thing ->
    
    1758
    -             mkSimpleDecorated $
    
    1759
    -               text "Illegal" <+> ppr_level <> colon <+> quotes (ppr renamer_thing)
    
    1755
    +             mkSimpleDecorated $ msg renamer_thing
    
    1760 1756
                Right typechecker_thing ->
    
    1761
    -             mkSimpleDecorated $ vcat
    
    1762
    -               [ text "An occurrence of" <+> quotes (ppr typechecker_thing) <+>
    
    1763
    -                 text "in a" <+> ppr_level <+> text "requires DataKinds."
    
    1764
    -               , text "Future versions of GHC will turn this warning into an error."
    
    1765
    -               ]
    
    1757
    +             mkSimpleDecorated $ msg typechecker_thing
    
    1766 1758
           where
    
    1767
    -        ppr_level = text $ levelString typeOrKind
    
    1759
    +        msg :: Outputable a => a -> SDoc
    
    1760
    +        msg thing = text "Illegal" <+> text (levelString typeOrKind) <>
    
    1761
    +                    colon <+> quotes (ppr thing)
    
    1768 1762
     
    
    1769 1763
         TcRnTypeSynonymCycle decl_or_tcs
    
    1770 1764
           -> mkSimpleDecorated $
    
    ... ... @@ -2567,17 +2561,8 @@ instance Diagnostic TcRnMessage where
    2567 2561
           -> ErrorWithoutFlag
    
    2568 2562
         TcRnUnusedQuantifiedTypeVar{}
    
    2569 2563
           -> WarningWithFlag Opt_WarnUnusedForalls
    
    2570
    -    TcRnDataKindsError _ thing
    
    2571
    -      -- DataKinds errors can arise from either the renamer (Left) or the
    
    2572
    -      -- typechecker (Right). The latter category of DataKinds errors are a
    
    2573
    -      -- fairly recent addition to GHC (introduced in GHC 9.10), and in order
    
    2574
    -      -- to prevent these new errors from breaking users' code, we temporarily
    
    2575
    -      -- downgrade these errors to warnings. See Note [Checking for DataKinds]
    
    2576
    -      -- (Wrinkle: Migration story for DataKinds typechecker errors)
    
    2577
    -      -- in GHC.Tc.Validity.
    
    2578
    -      -> case thing of
    
    2579
    -           Left  _ -> ErrorWithoutFlag
    
    2580
    -           Right _ -> WarningWithFlag Opt_WarnDataKindsTC
    
    2564
    +    TcRnDataKindsError{}
    
    2565
    +      -> ErrorWithoutFlag
    
    2581 2566
         TcRnTypeSynonymCycle{}
    
    2582 2567
           -> ErrorWithoutFlag
    
    2583 2568
         TcRnZonkerMessage msg
    

  • compiler/GHC/Tc/Errors/Types.hs
    ... ... @@ -2553,11 +2553,11 @@ data TcRnMessage where
    2553 2553
                       rename/should_fail/T22478e
    
    2554 2554
                       th/TH_Promoted1Tuple
    
    2555 2555
                       typecheck/should_compile/tcfail094
    
    2556
    -                  typecheck/should_compile/T22141a
    
    2557
    -                  typecheck/should_compile/T22141b
    
    2558
    -                  typecheck/should_compile/T22141c
    
    2559
    -                  typecheck/should_compile/T22141d
    
    2560
    -                  typecheck/should_compile/T22141e
    
    2556
    +                  typecheck/should_fail/T22141a
    
    2557
    +                  typecheck/should_fail/T22141b
    
    2558
    +                  typecheck/should_fail/T22141c
    
    2559
    +                  typecheck/should_fail/T22141d
    
    2560
    +                  typecheck/should_fail/T22141e
    
    2561 2561
                       typecheck/should_compile/T22141f
    
    2562 2562
                       typecheck/should_compile/T22141g
    
    2563 2563
                       typecheck/should_fail/T20873c
    

  • compiler/GHC/Tc/Validity.hs
    ... ... @@ -1001,18 +1001,11 @@ checkVdqOK ve tvbs ty = do
    1001 1001
     
    
    1002 1002
     -- | Check for a DataKinds violation in a kind context.
    
    1003 1003
     -- See @Note [Checking for DataKinds]@.
    
    1004
    ---
    
    1005
    --- Note that emitting DataKinds errors from the typechecker is a fairly recent
    
    1006
    --- addition to GHC (introduced in GHC 9.10), and in order to prevent these new
    
    1007
    --- errors from breaking users' code, we temporarily downgrade these errors to
    
    1008
    --- warnings. (This is why we use 'diagnosticTcM' below.) See
    
    1009
    --- @Note [Checking for DataKinds] (Wrinkle: Migration story for DataKinds
    
    1010
    --- typechecker errors)@.
    
    1011 1004
     checkDataKinds :: ValidityEnv -> Type -> TcM ()
    
    1012 1005
     checkDataKinds (ValidityEnv{ ve_ctxt = ctxt, ve_tidy_env = env }) ty = do
    
    1013 1006
       data_kinds <- xoptM LangExt.DataKinds
    
    1014
    -  diagnosticTcM
    
    1015
    -    (not (data_kinds || typeLevelUserTypeCtxt ctxt)) $
    
    1007
    +  checkTcM
    
    1008
    +    (data_kinds || typeLevelUserTypeCtxt ctxt) $
    
    1016 1009
         (env, TcRnDataKindsError KindLevel (Right (tidyType env ty)))
    
    1017 1010
     
    
    1018 1011
     {- Note [No constraints in kinds]
    
    ... ... @@ -1164,28 +1157,6 @@ different places in the code:
    1164 1157
       synonym), so we also catch a subset of kind-level violations in the renamer
    
    1165 1158
       to allow for earlier reporting of these errors.
    
    1166 1159
     
    
    1167
    ------
    
    1168
    --- Wrinkle: Migration story for DataKinds typechecker errors
    
    1169
    ------
    
    1170
    -
    
    1171
    -As mentioned above, DataKinds is checked in two different places: the renamer
    
    1172
    -and the typechecker. The checks in the renamer have been around since DataKinds
    
    1173
    -was introduced. The checks in the typechecker, on the other hand, are a fairly
    
    1174
    -recent addition, having been introduced in GHC 9.10. As such, it is possible
    
    1175
    -that there are some programs in the wild that (1) do not enable DataKinds, and
    
    1176
    -(2) were accepted by a previous GHC version, but would now be rejected by the
    
    1177
    -new DataKinds checks in the typechecker.
    
    1178
    -
    
    1179
    -To prevent the new DataKinds checks in the typechecker from breaking users'
    
    1180
    -code, we temporarily allow programs to compile if they violate a DataKinds
    
    1181
    -check in the typechecker, but GHC will emit a warning if such a violation
    
    1182
    -occurs. Users can then silence the warning by enabling DataKinds in the module
    
    1183
    -where the affected code lives. It is fairly straightforward to distinguish
    
    1184
    -between DataKinds violations arising from the renamer versus the typechecker,
    
    1185
    -as TcRnDataKindsError (the error message type classifying all DataKinds errors)
    
    1186
    -stores an Either field that is Left when the error comes from the renamer and
    
    1187
    -Right when the error comes from the typechecker.
    
    1188
    -
    
    1189 1160
     ************************************************************************
    
    1190 1161
     *                                                                      *
    
    1191 1162
     \subsection{Checking a theta or source type}
    

  • docs/users_guide/9.14.1-notes.rst
    ... ... @@ -70,6 +70,21 @@ Language
    70 70
     * The :extension:`ExplicitNamespaces` extension now allows the ``data``
    
    71 71
       namespace specifier in import and export lists.
    
    72 72
     
    
    73
    +* The ``-Wdata-kinds-tc`` warning has been deprecated, and the use of promoted
    
    74
    +  data types in kinds is now an error (rather than a warning) unless the
    
    75
    +  :extension:`DataKinds` extension is enabled. For example, the following code
    
    76
    +  will be rejected unless :extension:`DataKinds` is on:
    
    77
    +
    
    78
    +    import Data.Kind (Type)
    
    79
    +    import GHC.TypeNats (Nat)
    
    80
    +
    
    81
    +    -- Nat shouldn't be allowed here without DataKinds
    
    82
    +    data Vec :: Nat -> Type -> Type
    
    83
    +
    
    84
    +  (The ``-Wdata-kinds-tc`` warning was introduced in GHC 9.10 as part of a fix
    
    85
    +  for an accidental oversight in which programs like the one above were
    
    86
    +  mistakenly accepted without the use of :extension:`DataKinds`.)
    
    87
    +
    
    73 88
     * The :extension:`MonadComprehensions` extension now implies :extension:`ParallelListComp` as was originally intended (see `Monad Comprehensions <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/monad_comprehensions.html>`_).
    
    74 89
     
    
    75 90
     Compiler
    

  • docs/users_guide/using-warnings.rst
    ... ... @@ -82,7 +82,6 @@ as ``-Wno-...`` for every individual warning in the group.
    82 82
             * :ghc-flag:`-Winconsistent-flags`
    
    83 83
             * :ghc-flag:`-Wnoncanonical-monoid-instances`
    
    84 84
             * :ghc-flag:`-Wnoncanonical-monad-instances`
    
    85
    -        * :ghc-flag:`-Wdata-kinds-tc`
    
    86 85
             * :ghc-flag:`-Wimplicit-rhs-quantification`
    
    87 86
             * :ghc-flag:`-Wunusable-unpack-pragmas`
    
    88 87
     
    
    ... ... @@ -2601,24 +2600,19 @@ of ``-W(no-)*``.
    2601 2600
         is passed.
    
    2602 2601
     
    
    2603 2602
     .. ghc-flag:: -Wdata-kinds-tc
    
    2604
    -    :shortdesc: warn when an illegal use of a type or kind without
    
    2605
    -                :extension:`DataKinds` is caught by the typechecker
    
    2603
    +    :shortdesc: *(deprecated)* Does nothing
    
    2606 2604
         :type: dynamic
    
    2607
    -    :reverse: -Wno-data-kinds-tc
    
    2608 2605
     
    
    2609 2606
         :since: 9.10.1
    
    2610 2607
     
    
    2611
    -    Introduced in GHC 9.10.1, this warns when an illegal use of a type or kind
    
    2612
    -    (without having enabled the :extension:`DataKinds` extension) is caught in
    
    2613
    -    the typechecker (hence the ``-tc`` suffix). These warnings complement the
    
    2614
    -    existing :extension:`DataKinds` checks (that have existed since
    
    2615
    -    :extension:`DataKinds` was first introduced), which result in errors
    
    2616
    -    instead of warnings.
    
    2617
    -
    
    2618
    -    This warning is scheduled to be changed to an error in a future GHC
    
    2619
    -    version, at which point the :ghc-flag:`-Wdata-kinds-tc` flag will be
    
    2620
    -    removed. Users can enable the :extension:`DataKinds` extension to avoid
    
    2621
    -    issues (thus silencing the warning).
    
    2608
    +    This warning is deprecated. It no longer has any effect since GHC 9.14.
    
    2609
    +
    
    2610
    +    In the past, GHC 9.10 and 9.12 was overly permissive about which types or
    
    2611
    +    kinds could be used without enabling the :extension:`DataKinds` extension.
    
    2612
    +    In GHC 9.14 or later, however, GHC now consistently requires
    
    2613
    +    :extension:`DataKinds`, and all :extension:`DataKinds` violations are now
    
    2614
    +    errors. :ghc-flag:`-Wdata-kinds-tc` was used in the migration period before
    
    2615
    +    the breaking change took place.
    
    2622 2616
     
    
    2623 2617
     .. ghc-flag:: -Wdefaulted-exception-context
    
    2624 2618
         :shortdesc: warn when an :base-ref:`Control.Exception.Context.ExceptionContext`
    

  • testsuite/tests/typecheck/should_compile/T20873c.hs
    1
    +
    
    2
    +{-# LANGUAGE GADTSyntax, KindSignatures, NoDataKinds #-}
    
    3
    +
    
    4
    +module T20873c where
    
    5
    +
    
    6
    +import Data.Kind ( Type )
    
    7
    +
    
    8
    +type U a = Type
    
    9
    +
    
    10
    +-- This should be allowed without enabling DataKinds, This is because the return
    
    11
    +-- kind only mentions Type, which is always permitted in kinds, and U, which is
    
    12
    +-- simply a type synonym that expands to Type.
    
    13
    +data Foo :: U Type where
    
    14
    +  MkFoo :: Foo

  • testsuite/tests/typecheck/should_compile/T22141a.stderr deleted
    1
    -T22141a.hs:8:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    2
    -    • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
    
    3
    -      Future versions of GHC will turn this warning into an error.
    
    4
    -    • In the expansion of type synonym ‘Nat’
    
    5
    -      In the data type declaration for ‘Vector’
    
    6
    -    Suggested fix:
    
    7
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    8
    -

  • testsuite/tests/typecheck/should_compile/T22141b.stderr deleted
    1
    -T22141b.hs:10:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    2
    -    • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
    
    3
    -      Future versions of GHC will turn this warning into an error.
    
    4
    -    • In the expansion of type synonym ‘Nat’
    
    5
    -      In the expansion of type synonym ‘MyNat’
    
    6
    -      In the data type declaration for ‘Vector’
    
    7
    -    Suggested fix:
    
    8
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    9
    -

  • testsuite/tests/typecheck/should_compile/T22141c.stderr deleted
    1
    -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    2
    -    • An occurrence of ‘(# *, * #)’ in a kind requires DataKinds.
    
    3
    -      Future versions of GHC will turn this warning into an error.
    
    4
    -    • In the expansion of type synonym ‘T’
    
    5
    -      In a standalone kind signature for ‘D’: Proxy T -> Type
    
    6
    -    Suggested fix:
    
    7
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    8
    -
    
    9
    -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    10
    -    • An occurrence of ‘'[]’ in a kind requires DataKinds.
    
    11
    -      Future versions of GHC will turn this warning into an error.
    
    12
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    13
    -    Suggested fix:
    
    14
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    15
    -
    
    16
    -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    17
    -    • An occurrence of ‘'[GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
    
    18
    -      Future versions of GHC will turn this warning into an error.
    
    19
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    20
    -    Suggested fix:
    
    21
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    22
    -
    
    23
    -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    24
    -    • An occurrence of ‘[GHC.Internal.Types.LiftedRep,
    
    25
    -                         GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
    
    26
    -      Future versions of GHC will turn this warning into an error.
    
    27
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    28
    -    Suggested fix:
    
    29
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    30
    -
    
    31
    -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    32
    -    • An occurrence of ‘Proxy T’ in a kind requires DataKinds.
    
    33
    -      Future versions of GHC will turn this warning into an error.
    
    34
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    35
    -    Suggested fix:
    
    36
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    37
    -

  • testsuite/tests/typecheck/should_compile/T22141d.stderr deleted
    1
    -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    2
    -    • An occurrence of ‘(# * | * #)’ in a kind requires DataKinds.
    
    3
    -      Future versions of GHC will turn this warning into an error.
    
    4
    -    • In the expansion of type synonym ‘T’
    
    5
    -      In a standalone kind signature for ‘D’: Proxy T -> Type
    
    6
    -    Suggested fix:
    
    7
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    8
    -
    
    9
    -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    10
    -    • An occurrence of ‘'[]’ in a kind requires DataKinds.
    
    11
    -      Future versions of GHC will turn this warning into an error.
    
    12
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    13
    -    Suggested fix:
    
    14
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    15
    -
    
    16
    -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    17
    -    • An occurrence of ‘'[GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
    
    18
    -      Future versions of GHC will turn this warning into an error.
    
    19
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    20
    -    Suggested fix:
    
    21
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    22
    -
    
    23
    -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    24
    -    • An occurrence of ‘[GHC.Internal.Types.LiftedRep,
    
    25
    -                         GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
    
    26
    -      Future versions of GHC will turn this warning into an error.
    
    27
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    28
    -    Suggested fix:
    
    29
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    30
    -
    
    31
    -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    32
    -    • An occurrence of ‘Proxy T’ in a kind requires DataKinds.
    
    33
    -      Future versions of GHC will turn this warning into an error.
    
    34
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    35
    -    Suggested fix:
    
    36
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    37
    -

  • testsuite/tests/typecheck/should_compile/T22141e.stderr deleted
    1
    -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    2
    -    • An occurrence of ‘42’ in a kind requires DataKinds.
    
    3
    -      Future versions of GHC will turn this warning into an error.
    
    4
    -    • In the expansion of type synonym ‘T’
    
    5
    -      In a standalone kind signature for ‘D’: Proxy T -> Type
    
    6
    -    Suggested fix:
    
    7
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    8
    -
    
    9
    -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    10
    -    • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
    
    11
    -      Future versions of GHC will turn this warning into an error.
    
    12
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    13
    -    Suggested fix:
    
    14
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    15
    -
    
    16
    -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
    
    17
    -    • An occurrence of ‘Proxy T’ in a kind requires DataKinds.
    
    18
    -      Future versions of GHC will turn this warning into an error.
    
    19
    -    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    20
    -    Suggested fix:
    
    21
    -      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    22
    -

  • testsuite/tests/typecheck/should_compile/all.T
    ... ... @@ -819,6 +819,7 @@ test('T20588d', [extra_files(['T20588d.hs', 'T20588d.hs-boot', 'T20588d_aux.hs']
    819 819
     test('T20661', [extra_files(['T20661.hs', 'T20661.hs-boot', 'T20661_aux.hs'])], multimod_compile, ['T20661_aux.hs', '-v0'])
    
    820 820
     test('T20873', normal, compile, [''])
    
    821 821
     test('T20873b', [extra_files(['T20873b_aux.hs'])], multimod_compile, ['T20873b', '-v0'])
    
    822
    +test('T20873c', normal, compile, [''])
    
    822 823
     test('StaticPtrTypeFamily', normal, compile, [''])
    
    823 824
     test('T20946', normal, compile, [''])
    
    824 825
     test('T20996', normal, compile, [''])
    
    ... ... @@ -864,11 +865,6 @@ test('T21951a', normal, compile, ['-Wredundant-strictness-flags'])
    864 865
     test('T21951b', normal, compile, ['-Wredundant-strictness-flags'])
    
    865 866
     test('DataToTagSolving', normal, compile, [''])
    
    866 867
     test('T21550', normal, compile, [''])
    
    867
    -test('T22141a', normal, compile, [''])
    
    868
    -test('T22141b', normal, compile, [''])
    
    869
    -test('T22141c', normal, compile, [''])
    
    870
    -test('T22141d', normal, compile, [''])
    
    871
    -test('T22141e', [extra_files(['T22141e_Aux.hs'])], multimod_compile, ['T22141e.hs', '-v0'])
    
    872 868
     test('T22141f', normal, compile, [''])
    
    873 869
     test('T22141g', normal, compile, [''])
    
    874 870
     test('T22310', normal, compile, [''])
    

  • testsuite/tests/typecheck/should_fail/T20873c.hs deleted
    1
    -
    
    2
    -{-# LANGUAGE GADTSyntax, NoKindSignatures, NoDataKinds #-}
    
    3
    -
    
    4
    -module T20873c where
    
    5
    -
    
    6
    -import Data.Kind ( Type )
    
    7
    -
    
    8
    -type U a = Type
    
    9
    -
    
    10
    -data Foo :: U Int where
    
    11
    -  MkFoo :: Foo

  • testsuite/tests/typecheck/should_fail/T20873c.stderr deleted
    1
    -T20873c.hs:10:1: error: [GHC-49378]
    
    2
    -    • Illegal kind signature ‘Foo :: U Int’
    
    3
    -    • In the data type declaration for ‘Foo’
    
    4
    -    Suggested fix:
    
    5
    -      Perhaps you intended to use the ‘KindSignatures’ extension (implied by ‘TypeFamilies’ and ‘PolyKinds’)
    
    6
    -

  • testsuite/tests/typecheck/should_compile/T22141a.hstestsuite/tests/typecheck/should_fail/T22141a.hs

  • testsuite/tests/typecheck/should_fail/T22141a.stderr
    1
    -
    
    2 1
     T22141a.hs:8:1: error: [GHC-68567]
    
    3
    -    • Illegal kind: ‘GHC.Num.Natural.Natural’
    
    2
    +    • Illegal kind: ‘GHC.Internal.Bignum.Natural.Natural’
    
    4 3
         • In the expansion of type synonym ‘Nat’
    
    5 4
           In the data type declaration for ‘Vector’
    
    6
    -    Suggested fix: Perhaps you intended to use DataKinds
    5
    +    Suggested fix:
    
    6
    +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    7
    +

  • testsuite/tests/typecheck/should_compile/T22141b.hstestsuite/tests/typecheck/should_fail/T22141b.hs

  • testsuite/tests/typecheck/should_fail/T22141b.stderr
    1
    -
    
    2 1
     T22141b.hs:10:1: error: [GHC-68567]
    
    3
    -    • Illegal kind: ‘GHC.Num.Natural.Natural’
    
    2
    +    • Illegal kind: ‘GHC.Internal.Bignum.Natural.Natural’
    
    4 3
         • In the expansion of type synonym ‘Nat’
    
    5 4
           In the expansion of type synonym ‘MyNat’
    
    6 5
           In the data type declaration for ‘Vector’
    
    7
    -    Suggested fix: Perhaps you intended to use DataKinds
    6
    +    Suggested fix:
    
    7
    +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    8
    +

  • testsuite/tests/typecheck/should_compile/T22141c.hstestsuite/tests/typecheck/should_fail/T22141c.hs

  • testsuite/tests/typecheck/should_fail/T22141c.stderr
    1
    +T22141c.hs:10:11: error: [GHC-68567]
    
    2
    +    • Illegal kind: ‘Proxy T’
    
    3
    +    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    4
    +    Suggested fix:
    
    5
    +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    1 6
     
    2
    -T22141c.hs:8:17: error: [GHC-68567]
    
    3
    -    Illegal kind: ‘(# Type, Type #)’
    
    4
    -    Suggested fix: Perhaps you intended to use DataKinds

  • testsuite/tests/typecheck/should_compile/T22141d.hstestsuite/tests/typecheck/should_fail/T22141d.hs

  • testsuite/tests/typecheck/should_fail/T22141d.stderr
    1
    +T22141d.hs:10:11: error: [GHC-68567]
    
    2
    +    • Illegal kind: ‘Proxy T’
    
    3
    +    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    4
    +    Suggested fix:
    
    5
    +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    1 6
     
    2
    -T22141d.hs:8:17: error: [GHC-68567]
    
    3
    -    Illegal kind: ‘(# Type | Type #)’
    
    4
    -    Suggested fix: Perhaps you intended to use DataKinds

  • testsuite/tests/typecheck/should_compile/T22141e.hstestsuite/tests/typecheck/should_fail/T22141e.hs

  • testsuite/tests/typecheck/should_fail/T22141e.stderr
    1
    +T22141e.hs:8:11: error: [GHC-68567]
    
    2
    +    • Illegal kind: ‘Proxy T’
    
    3
    +    • In a standalone kind signature for ‘D’: Proxy T -> Type
    
    4
    +    Suggested fix:
    
    5
    +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
    
    1 6
     
    2
    -T22141e.hs:7:17: error: [GHC-68567]
    
    3
    -    Illegal kind: ‘42’
    
    4
    -    Suggested fix: Perhaps you intended to use DataKinds

  • testsuite/tests/typecheck/should_compile/T22141e_Aux.hstestsuite/tests/typecheck/should_fail/T22141e_Aux.hs

  • testsuite/tests/typecheck/should_fail/all.T
    ... ... @@ -646,7 +646,6 @@ test('T20542', normal, compile_fail, [''])
    646 646
     test('T20588', [extra_files(['T20588.hs', 'T20588.hs-boot', 'T20588_aux.hs'])], multimod_compile_fail, ['T20588_aux.hs', '-v0'])
    
    647 647
     test('T20588c', [extra_files(['T20588c.hs', 'T20588c.hs-boot', 'T20588c_aux.hs'])], multimod_compile_fail, ['T20588c_aux.hs', '-v0'])
    
    648 648
     test('T20189', normal, compile_fail, [''])
    
    649
    -test('T20873c', normal, compile_fail, [''])
    
    650 649
     test('T20873d', normal, compile_fail, [''])
    
    651 650
     test('FunDepOrigin1b', normal, compile_fail, [''])
    
    652 651
     test('FD1', normal, compile_fail, [''])
    
    ... ... @@ -667,6 +666,11 @@ test('T21447', normal, compile_fail, [''])
    667 666
     test('T21530a', normal, compile_fail, [''])
    
    668 667
     test('T21530b', normal, compile_fail, [''])
    
    669 668
     test('Or4', normal, compile_fail, [''])
    
    669
    +test('T22141a', normal, compile_fail, [''])
    
    670
    +test('T22141b', normal, compile_fail, [''])
    
    671
    +test('T22141c', normal, compile_fail, [''])
    
    672
    +test('T22141d', normal, compile_fail, [''])
    
    673
    +test('T22141e', [extra_files(['T22141e_Aux.hs'])], multimod_compile_fail, ['T22141e.hs', '-v0'])
    
    670 674
     test('T22570', normal, compile_fail, [''])
    
    671 675
     test('T22645', normal, compile_fail, [''])
    
    672 676
     test('T20666', normal, compile_fail, [''])
    

  • testsuite/tests/vdq-rta/should_fail/T23739_fail_case.hs
    1
    +{-# LANGUAGE DataKinds #-}
    
    1 2
     {-# LANGUAGE RequiredTypeArguments #-}
    
    2 3
     
    
    3 4
     module T23739_fail_case where
    
    ... ... @@ -6,4 +7,4 @@ bad :: forall (b :: Bool) -> String
    6 7
     bad t =
    
    7 8
       case t of
    
    8 9
         False -> "False"
    
    9
    -    True  -> "True"
    \ No newline at end of file
    10
    +    True  -> "True"

  • testsuite/tests/vdq-rta/should_fail/T23739_fail_case.stderr
    1
    -
    
    2
    -T23739_fail_case.hs:7:8: error: [GHC-01928]
    
    1
    +T23739_fail_case.hs:8:8: error: [GHC-01928]
    
    3 2
         • Illegal term-level use of the type variable ‘t’
    
    4
    -    • bound at T23739_fail_case.hs:6:5
    
    3
    +    • bound at T23739_fail_case.hs:7:5
    
    5 4
         • In the expression: t
    
    6 5
           In the expression:
    
    7 6
             case t of
    
    ... ... @@ -12,3 +11,4 @@ T23739_fail_case.hs:7:8: error: [GHC-01928]
    12 11
                 = case t of
    
    13 12
                     False -> "False"
    
    14 13
                     True -> "True"
    
    14
    +