Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

25 changed files:

Changes:

  • .gitlab/ci.sh
    ... ... @@ -652,6 +652,10 @@ function test_hadrian() {
    652 652
       check_msys2_deps _build/stage1/bin/ghc --version
    
    653 653
       check_release_build
    
    654 654
     
    
    655
    +  # GitLab's log viewer renders ANSI colors, but stdout here is not a tty,
    
    656
    +  # so the driver must be told to emit them.
    
    657
    +  RUNTEST_ARGS="${RUNTEST_ARGS:-} --force-colors"
    
    658
    +
    
    655 659
       # Ensure that statically-linked builds are actually static
    
    656 660
       if [[ "${BUILD_FLAVOUR}" = *static* ]]; then
    
    657 661
         bad_execs=""
    

  • changelog.d/T27455
    1
    +section: base
    
    2
    +issues: #27455
    
    3
    +mrs: !16274
    
    4
    +synopsis:
    
    5
    +  Don't drop `ExceptionContext` in `SomeException(toException)`
    
    6
    +description:
    
    7
    +  Previously the implementation of ``Exception(toException)`` given to `SomeException` would inappropriately drop the carried `ExceptionContext`. Now ``toException = id``, faithfully implementing the semantics proposed in :ref:`CLC Proposal #200 <https://github.com/haskell/core-libraries-committee/issues/200>`.
    
    8
    +

  • compiler/GHC/Builtin/Utils.hs
    ... ... @@ -301,7 +301,7 @@ ghcPrimWarns = WarnSome
    301 301
       []
    
    302 302
       where
    
    303 303
         mk_txt msg =
    
    304
    -      DeprecatedTxt NoSourceText [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText (fastStringToShortText msg)) []]
    
    304
    +      DeprecatedTxt (NoSourceText, noAnn) [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText (fastStringToShortText msg)) []]
    
    305 305
         mk_decl_dep (occ, msg) = (occ, mk_txt msg)
    
    306 306
     
    
    307 307
     ghcPrimFixities :: [(OccName,Fixity)]
    

  • compiler/GHC/Hs/Decls.hs
    ... ... @@ -1043,7 +1043,7 @@ cidDeprecation :: forall p. IsPass p
    1043 1043
     cidDeprecation = fmap unLoc . decl_deprecation (ghcPass @p)
    
    1044 1044
       where
    
    1045 1045
         decl_deprecation :: GhcPass p  -> ClsInstDecl (GhcPass p)
    
    1046
    -                     -> Maybe (LocatedP (WarningTxt (GhcPass p)))
    
    1046
    +                     -> Maybe (LocatedA (WarningTxt (GhcPass p)))
    
    1047 1047
         decl_deprecation GhcPs (ClsInstDecl{ cid_ext = (depr, _) } )
    
    1048 1048
           = depr
    
    1049 1049
         decl_deprecation GhcRn (ClsInstDecl{ cid_ext = (depr, _) })
    
    ... ... @@ -1242,7 +1242,7 @@ derivDeprecation :: forall p. IsPass p
    1242 1242
     derivDeprecation = fmap unLoc . decl_deprecation (ghcPass @p)
    
    1243 1243
       where
    
    1244 1244
         decl_deprecation :: GhcPass p  -> DerivDecl (GhcPass p)
    
    1245
    -                     -> Maybe (LocatedP (WarningTxt (GhcPass p)))
    
    1245
    +                     -> Maybe (LocatedA (WarningTxt (GhcPass p)))
    
    1246 1246
         decl_deprecation GhcPs (DerivDecl{ deriv_ext = (depr, _) })
    
    1247 1247
           = depr
    
    1248 1248
         decl_deprecation GhcRn (DerivDecl{ deriv_ext = (depr, _) })
    

  • compiler/GHC/Hs/Dump.hs
    ... ... @@ -99,7 +99,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    99 99
                   `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
    
    100 100
                   `ext2Q` located
    
    101 101
                   `extQ` srcSpanAnnA
    
    102
    -              `extQ` srcSpanAnnP
    
    103 102
                   `extQ` srcSpanAnnN
    
    104 103
                   `extQ` srcSpanAnnBF
    
    105 104
     
    
    ... ... @@ -409,9 +408,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    409 408
                 srcSpanAnnA :: EpAnn [TrailingAnn] -> SDoc
    
    410 409
                 srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA")
    
    411 410
     
    
    412
    -            srcSpanAnnP :: EpAnn AnnPragma -> SDoc
    
    413
    -            srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP")
    
    414
    -
    
    415 411
                 srcSpanAnnN :: EpAnn NameAnn -> SDoc
    
    416 412
                 srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN")
    
    417 413
     
    

  • compiler/GHC/Iface/Syntax.hs
    ... ... @@ -83,7 +83,7 @@ import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag )
    83 83
     import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
    
    84 84
     import GHC.Builtin.Types ( constraintKindTyConName )
    
    85 85
     import GHC.Stg.EnforceEpt.TagSig
    
    86
    -import GHC.Parser.Annotation (noLocA)
    
    86
    +import GHC.Parser.Annotation (noLocA, noAnn)
    
    87 87
     import GHC.Hs.Extension ( GhcPass, GhcRn, GhcTc )
    
    88 88
     import GHC.Hs.Decls.Overlap ( OverlapFlag )
    
    89 89
     import GHC.Hs.Doc ( WithHsDocIdentifiers(..) )
    
    ... ... @@ -666,8 +666,8 @@ fromIfaceWarnings = \case
    666 666
     
    
    667 667
     fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn
    
    668 668
     fromIfaceWarningTxt = \case
    
    669
    -    IfWarningTxt src mb_cat strs -> WarningTxt src (noLocA . fromWarningCategory <$> mb_cat) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    
    670
    -    IfDeprecatedTxt src strs -> DeprecatedTxt src (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    
    669
    +    IfWarningTxt src mb_cat strs -> WarningTxt (src, noAnn) (noLocA . fromWarningCategory <$> mb_cat) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    
    670
    +    IfDeprecatedTxt src strs -> DeprecatedTxt (src, noAnn) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    
    671 671
     
    
    672 672
     fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers (StringLiteral GhcRn) GhcRn
    
    673 673
     fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLocA names)
    

  • compiler/GHC/Iface/Warnings.hs
    ... ... @@ -22,12 +22,11 @@ toIfaceWarnings (WarnSome vs ds) = IfWarnSome vs' ds'
    22 22
         ds' = [(occ, toIfaceWarningTxt txt) | (occ, txt) <- ds]
    
    23 23
     
    
    24 24
     toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
    
    25
    -toIfaceWarningTxt (WarningTxt src mb_cat strs) = IfWarningTxt src (unLoc . iwc_wc . unLoc <$> mb_cat) (map (toIfaceStringLiteralWithNames . unLoc) strs)
    
    26
    -toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
    
    25
    +toIfaceWarningTxt (WarningTxt (src, _) mb_cat strs) = IfWarningTxt src (unLoc . iwc_wc . unLoc <$> mb_cat) (map (toIfaceStringLiteralWithNames . unLoc) strs)
    
    26
    +toIfaceWarningTxt (DeprecatedTxt (src, _) strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
    
    27 27
     
    
    28 28
     toIfaceStringLiteralWithNames :: WithHsDocIdentifiers (StringLiteral GhcRn) GhcRn -> (IfaceStringLiteral, [IfExtName])
    
    29 29
     toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names)
    
    30 30
     
    
    31 31
     toIfaceStringLiteral :: StringLiteral GhcRn -> IfaceStringLiteral
    
    32
    -toIfaceStringLiteral sLit =
    
    33
    -  IfStringLiteral (stringLitSourceText sLit) (sl_fs sLit)
    32
    +toIfaceStringLiteral sLit = IfStringLiteral (stringLitSourceText sLit) (sl_fs sLit)

  • compiler/GHC/Parser.y
    ... ... @@ -2077,11 +2077,13 @@ to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
    2077 2077
     
    
    2078 2078
     maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
    
    2079 2079
             : '{-# DEPRECATED' strings '#-}'
    
    2080
    -                            {% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (snd $ unLoc $2))
    
    2081
    -                                (AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn) }
    
    2080
    +                            {% fmap Just $ amsA' (sLL $1 $> $
    
    2081
    +                                DeprecatedTxt (getDEPRECATED_PRAGs $1, AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn)
    
    2082
    +                                              (snd $ unLoc $2))}
    
    2082 2083
             | '{-# WARNING' warning_category strings '#-}'
    
    2083
    -                            {% fmap Just $ amsr (sLL $1 $> $ WarningTxt (getWARNING_PRAGs $1) $2 (snd $ unLoc $3))
    
    2084
    -                                (AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)}
    
    2084
    +                            {% fmap Just $ amsA' (sLL $1 $> $
    
    2085
    +                                WarningTxt (getWARNING_PRAGs $1, AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)
    
    2086
    +                                           $2 (snd $ unLoc $3))}
    
    2085 2087
             |  {- empty -}      { Nothing }
    
    2086 2088
     
    
    2087 2089
     warning_category :: { Maybe (LocatedE (InWarningCategory GhcPs)) }
    
    ... ... @@ -2110,7 +2112,7 @@ warning :: { OrdList (LWarnDecl GhcPs) }
    2110 2112
             : warning_category namespace_spec namelist strings
    
    2111 2113
                     {% fmap unitOL $ amsA' (L (comb4 $1 $2 $3 $4)
    
    2112 2114
                          (Warning (fst $ unLoc $4) (unLoc $2) (unLoc $3)
    
    2113
    -                              (WarningTxt NoSourceText $1 (snd $ unLoc $4)))) }
    
    2115
    +                              (WarningTxt (NoSourceText, noAnn) $1 (snd $ unLoc $4)))) }
    
    2114 2116
     
    
    2115 2117
     namespace_spec :: { Located (NamespaceSpecifier GhcPs) }
    
    2116 2118
       : 'type'      { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }
    
    ... ... @@ -2138,7 +2140,7 @@ deprecations :: { OrdList (LWarnDecl GhcPs) }
    2138 2140
     deprecation :: { OrdList (LWarnDecl GhcPs) }
    
    2139 2141
             : namespace_spec namelist strings
    
    2140 2142
                  {% fmap unitOL $ amsA' (sL (comb3 $1 $2 $>) $ (Warning (fst $ unLoc $3) (unLoc $1) (unLoc $2)
    
    2141
    -                                          (DeprecatedTxt NoSourceText $ snd $ unLoc $3))) }
    
    2143
    +                                          (DeprecatedTxt (NoSourceText, noAnn) $ snd $ unLoc $3))) }
    
    2142 2144
     
    
    2143 2145
     strings :: { Located ((EpToken "[", EpToken "]"), [LocatedA (WithHsDocIdentifiers (StringLiteral GhcPs) GhcPs)]) }
    
    2144 2146
         : STRING             { sL1 $1 (noAnn,[stringLiteralToHsDocWst (L (gl $1) (getStringLiteral $1))]) }
    

  • compiler/GHC/Parser/Annotation.hs
    ... ... @@ -27,9 +27,9 @@ module GHC.Parser.Annotation (
    27 27
       EpAnnCO,
    
    28 28
     
    
    29 29
       -- ** Annotations in 'GenLocated'
    
    30
    -  LocatedA, LocatedN, LocatedAn, LocatedP,
    
    30
    +  LocatedA, LocatedN, LocatedAn,
    
    31 31
       LocatedE, LocatedBF,
    
    32
    -  SrcSpanAnnA, SrcSpanAnnP, SrcSpanAnnN,
    
    32
    +  SrcSpanAnnA, SrcSpanAnnN,
    
    33 33
       SrcSpanAnnBF,
    
    34 34
     
    
    35 35
       -- ** Annotation data types used in 'GenLocated'
    
    ... ... @@ -430,7 +430,6 @@ emptyComments = EpaComments []
    430 430
     type LocatedA = GenLocated SrcSpanAnnA
    
    431 431
     type LocatedN = GenLocated SrcSpanAnnN
    
    432 432
     
    
    433
    -type LocatedP = GenLocated SrcSpanAnnP
    
    434 433
     type LocatedBF = GenLocated SrcSpanAnnBF
    
    435 434
     
    
    436 435
     -- | Annotation for items appearing in a list. They can have one or
    
    ... ... @@ -441,7 +440,6 @@ type SrcSpanAnnA = EpAnn [TrailingAnn]
    441 440
     -- on the context, such as backticks.
    
    442 441
     type SrcSpanAnnN = EpAnn NameAnn
    
    443 442
     
    
    444
    -type SrcSpanAnnP = EpAnn AnnPragma
    
    445 443
     type SrcSpanAnnBF = EpAnn AnnBooleanFormula
    
    446 444
     
    
    447 445
     type LocatedE = GenLocated EpaLocation
    

  • compiler/GHC/Unit/Module/Warnings.hs
    ... ... @@ -158,8 +158,8 @@ warningTxtSame w1 w2
    158 158
     instance Outputable (InWarningCategory (GhcPass pass)) where
    
    159 159
       ppr (InWarningCategory _ wt) = text "in" <+> doubleQuotes (ppr wt)
    
    160 160
     
    
    161
    -type instance XDeprecatedTxt       (GhcPass _) = SourceText
    
    162
    -type instance XWarningTxt          (GhcPass _) = SourceText
    
    161
    +type instance XDeprecatedTxt       (GhcPass _) = (SourceText, AnnPragma)
    
    162
    +type instance XWarningTxt          (GhcPass _) = (SourceText, AnnPragma)
    
    163 163
     type instance XXWarningTxt         (GhcPass _) = DataConCantHappen
    
    164 164
     type instance XInWarningCategory   (GhcPass _) = (EpToken "in", SourceText)
    
    165 165
     type instance XXInWarningCategory  (GhcPass _) = DataConCantHappen
    
    ... ... @@ -167,7 +167,7 @@ type instance XXInWarningCategory (GhcPass _) = DataConCantHappen
    167 167
     type instance Anno (WithHsDocIdentifiers (StringLiteral pass) pass) = SrcSpanAnnA
    
    168 168
     type instance Anno (InWarningCategory (GhcPass pass)) = EpaLocation
    
    169 169
     type instance Anno (WarningCategory) = EpaLocation
    
    170
    -type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
    
    170
    +type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnA
    
    171 171
     
    
    172 172
     deriving stock instance Eq (WarningTxt GhcPs)
    
    173 173
     deriving stock instance Eq (WarningTxt GhcRn)
    
    ... ... @@ -190,15 +190,15 @@ deriving instance Outputable WarningCategory
    190 190
     instance Outputable (WarningTxt (GhcPass pass)) where
    
    191 191
         ppr (WarningTxt lsrc mcat ws)
    
    192 192
           = case lsrc of
    
    193
    -            NoSourceText   -> pp_ws ws
    
    194
    -            SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
    
    193
    +            (NoSourceText, _)   -> pp_ws ws
    
    194
    +            (SourceText src, _) -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
    
    195 195
             where
    
    196 196
               ctg_doc = maybe empty (\ctg -> ppr ctg) mcat
    
    197 197
     
    
    198 198
         ppr (DeprecatedTxt lsrc ds)
    
    199 199
           = case lsrc of
    
    200
    -          NoSourceText   -> pp_ws ds
    
    201
    -          SourceText src -> ftext src <+> pp_ws ds <+> text "#-}"
    
    200
    +          (NoSourceText, _)   -> pp_ws ds
    
    201
    +          (SourceText src, _) -> ftext src <+> pp_ws ds <+> text "#-}"
    
    202 202
     
    
    203 203
     pp_ws :: [LocatedA (WithHsDocIdentifiers (StringLiteral (GhcPass p)) (GhcPass p))] -> SDoc
    
    204 204
     pp_ws [l] = ppr $ unLoc l
    

  • libraries/base/changelog.md
    ... ... @@ -38,6 +38,7 @@
    38 38
       * Show `ExceptionContext` in `displayExceptionAnnotation` implementation of `WhileHandling` ([GHC #27456](https://gitlab.haskell.org/ghc/ghc/-/issues/27456))
    
    39 39
       * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387))
    
    40 40
       * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371))
    
    41
    +  * The implementation of `toException` in `SomeException`'s `Exception` instance no longer drops exception context, in keeping with the behavior originally proposed in [CLC Proposal #200](https://github.com/haskell/core-libraries-committee/issues/200).
    
    41 42
       * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397))
    
    42 43
       * Improve error message for `Data.Char.chr`. ([CLC Proposal #384](https://github.com/haskell/core-libraries-committee/issues/384))
    
    43 44
     
    

  • libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
    ... ... @@ -55,7 +55,7 @@ import GHC.Internal.Data.Maybe
    55 55
     import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast)
    
    56 56
     import qualified GHC.Internal.Data.Typeable as Typeable
    
    57 57
        -- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception
    
    58
    -import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++))
    
    58
    +import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++), id)
    
    59 59
     import GHC.Internal.Show
    
    60 60
     import GHC.Internal.Types (Bool(..))
    
    61 61
     import GHC.Internal.Exception.Context
    
    ... ... @@ -208,7 +208,16 @@ Caught MismatchedParentheses
    208 208
     
    
    209 209
     -}
    
    210 210
     class (Typeable e, Show e) => Exception e where
    
    211
    -    -- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'.
    
    211
    +    -- | 'toException' converts an exception into the existential 'SomeException'
    
    212
    +    -- wrapper type.
    
    213
    +    --
    
    214
    +    -- In doing so, 'toException' should not /add/ an 'ExceptionContext'.
    
    215
    +    --
    
    216
    +    --   - In most cases, the exception does not store its own 'ExceptionContext'.
    
    217
    +    --     The default implementation of 'toException' (which does not store any
    
    218
    +    --     'ExceptionContext') is suitable for these cases.
    
    219
    +    --   - In the rare case that the exception itself stores an 'ExceptionContext',
    
    220
    +    --     this context should be preserved by 'toException'.
    
    212 221
         toException   :: e -> SomeException
    
    213 222
         fromException :: SomeException -> Maybe e
    
    214 223
     
    
    ... ... @@ -231,13 +240,11 @@ class (Typeable e, Show e) => Exception e where
    231 240
     -- | @since base-4.8.0.0
    
    232 241
     instance Exception Void
    
    233 242
     
    
    234
    --- | This drops any attached 'ExceptionContext'.
    
    243
    +-- | NB: this instance preserves the attached 'ExceptionContext'.
    
    235 244
     --
    
    236 245
     -- @since base-3.0
    
    237 246
     instance Exception SomeException where
    
    238
    -    toException (SomeException e) =
    
    239
    -        let ?exceptionContext = emptyExceptionContext
    
    240
    -        in SomeException e
    
    247
    +    toException = id
    
    241 248
         fromException = Just
    
    242 249
         backtraceDesired (SomeException e) = backtraceDesired e
    
    243 250
         displayException (SomeException e) = displayException e
    

  • testsuite/driver/runtests.py
    ... ... @@ -94,6 +94,8 @@ parser.add_argument("--ignore-perf-failures", choices=['increases','decreases','
    94 94
                             help="Do not fail due to out-of-tolerance perf tests")
    
    95 95
     parser.add_argument("--only-report-hadrian-deps", type=Path,
    
    96 96
                             help="Dry run the testsuite and report all extra hadrian dependencies needed on the given file")
    
    97
    +parser.add_argument("--force-colors", action="store_true",
    
    98
    +                        help="emit ANSI colors even when stdout is not a tty (e.g. for CI logs)")
    
    97 99
     
    
    98 100
     args = parser.parse_args()
    
    99 101
     
    
    ... ... @@ -259,7 +261,9 @@ def supports_colors():
    259 261
         return True
    
    260 262
     
    
    261 263
     config.supports_colors = supports_colors()
    
    262
    -term_color.enable_color = config.supports_colors
    
    264
    +# config.supports_colors deliberately stays tty-based: it also guards
    
    265
    +# terminal-title updates, which must not end up in a CI log.
    
    266
    +term_color.enable_color = config.supports_colors or args.force_colors
    
    263 267
     
    
    264 268
     # This has to come after arg parsing as the args can change the compiler
    
    265 269
     get_compiler_info()
    
    ... ... @@ -587,7 +591,7 @@ else:
    587 591
             print(Perf.allow_changes_string([(m.change, m.stat) for m in t.metrics]))
    
    588 592
             print('-' * 25)
    
    589 593
     
    
    590
    -    summary(t, sys.stdout, color=config.supports_colors)
    
    594
    +    summary(t, sys.stdout, color=term_color.enable_color, junit_path=args.junit)
    
    591 595
     
    
    592 596
         # Write perf stats if any exist or if a metrics file is specified.
    
    593 597
         stats_metrics = [stat for (_, stat, __) in t.metrics] # type: List[PerfStat]
    

  • testsuite/driver/term_color.py
    1 1
     from enum import Enum
    
    2 2
     
    
    3
    +# Whether to emit color escapes; set in runtests.py.
    
    3 4
     enable_color = True
    
    4 5
     
    
    5 6
     class Color(Enum):
    
    ... ... @@ -18,3 +19,7 @@ def colored(color: Color, s: str) -> str:
    18 19
         else:
    
    19 20
             return s
    
    20 21
     
    
    22
    +# For renderers that serve several sinks: `enabled` says whether *this* sink
    
    23
    +# takes color (the summary is written both to stdout and to a plain-text file).
    
    24
    +def colored_if(enabled: bool, color: Color, s: str) -> str:
    
    25
    +    return colored(color, s) if enabled else s

  • testsuite/driver/testlib.py
    ... ... @@ -27,7 +27,7 @@ from testutil import strip_quotes, lndir, link_or_copy_file, passed, \
    27 27
                          failBecause, testing_metrics, residency_testing_metrics, \
    
    28 28
                          stable_perf_counters, \
    
    29 29
                          PassFail, badResult, str_warn, str_removeprefix
    
    30
    -from term_color import Color, colored
    
    30
    +from term_color import Color, colored_if
    
    31 31
     import testutil
    
    32 32
     from cpu_features import have_cpu_feature
    
    33 33
     import perf_notes as Perf
    
    ... ... @@ -1499,6 +1499,19 @@ def _newTestDir(name: TestName, opts: TestOptions, tempdir, dir):
    1499 1499
         opts.testdir_raw = Path(os.path.join(tempdir, testdir, name + testdir_suffix))
    
    1500 1500
         opts.compiler_always_flags = config.compiler_always_flags
    
    1501 1501
     
    
    1502
    +def _result_directory(opts: TestOptions) -> str:
    
    1503
    +    # The test's source directory, relative to the GHC source root, so it reads
    
    1504
    +    # the same regardless of which directory `make` was invoked from.
    
    1505
    +    srcdir = opts.srcdir
    
    1506
    +    if srcdir is None:
    
    1507
    +        return ''
    
    1508
    +    try:
    
    1509
    +        return os.path.relpath(srcdir, config.top.parent)
    
    1510
    +    except ValueError:
    
    1511
    +        # No relative path exists (e.g. different Windows drives); the
    
    1512
    +        # absolute path is still more useful than nothing.
    
    1513
    +        return str(srcdir)
    
    1514
    +
    
    1502 1515
     # -----------------------------------------------------------------------------
    
    1503 1516
     # Actually doing tests
    
    1504 1517
     
    
    ... ... @@ -1823,7 +1836,7 @@ async def do_test(name: TestName,
    1823 1836
         if opts.expect not in ['pass', 'fail', 'missing-lib']:
    
    1824 1837
             framework_fail(name, way, 'bad expected ' + opts.expect)
    
    1825 1838
     
    
    1826
    -    directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
    
    1839
    +    directory = _result_directory(opts)
    
    1827 1840
     
    
    1828 1841
         if way in opts.fragile_ways:
    
    1829 1842
             if_verbose(1, '*** fragile test %s resulted in %s' % (full_name, 'pass' if result.passed else 'fail'))
    
    ... ... @@ -1877,7 +1890,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
    1877 1890
         # so we need to take care not to blow up with the wrong way
    
    1878 1891
         # and report the actual reason for the failure.
    
    1879 1892
         try:
    
    1880
    -      directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
    
    1893
    +      directory = _result_directory(opts)
    
    1881 1894
         except:
    
    1882 1895
           directory = ''
    
    1883 1896
         full_name = '%s(%s)' % (name, way)
    
    ... ... @@ -1890,7 +1903,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
    1890 1903
     
    
    1891 1904
     def framework_warn(name: TestName, way: WayName, reason: str) -> None:
    
    1892 1905
         opts = getTestOpts()
    
    1893
    -    directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
    
    1906
    +    directory = _result_directory(opts)
    
    1894 1907
         full_name = name + '(' + way + ')'
    
    1895 1908
         if_verbose(1, '*** framework warning for %s %s ' % (full_name, reason))
    
    1896 1909
         t.framework_warnings.append(TestResult(directory, name, reason, way))
    
    ... ... @@ -2445,19 +2458,23 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
    2445 2458
                 dump_stdout(name)
    
    2446 2459
                 dump_stderr(name)
    
    2447 2460
             message = format_bad_exit_code_message(exit_code)
    
    2448
    -        return failBecause(message)
    
    2461
    +        return failBecause(message,
    
    2462
    +                           stderr=read_stderr(name),
    
    2463
    +                           stdout=read_stdout(name))
    
    2449 2464
     
    
    2450 2465
         stderr_match = CompareOutput(True) if (opts.ignore_stderr or opts.combined_output) else await stderr_ok(name, way)
    
    2451 2466
         if not stderr_match:
    
    2467
    +        # The diff already contains the mismatching stream; see Note [Redundant
    
    2468
    +        # output in test results].
    
    2452 2469
             return failBecause('bad stderr',
    
    2453
    -                           stderr=read_stderr(name),
    
    2470
    +                           stderr=None if stderr_match.diff else read_stderr(name),
    
    2454 2471
                                stdout=read_stdout(name),
    
    2455 2472
                                diff=stderr_match.diff)
    
    2456 2473
         stdout_match = CompareOutput(True) if opts.ignore_stdout else await stdout_ok(name, way)
    
    2457 2474
         if not stdout_match:
    
    2458 2475
             return failBecause('bad stdout',
    
    2459 2476
                                stderr=read_stderr(name),
    
    2460
    -                           stdout=read_stdout(name),
    
    2477
    +                           stdout=None if stdout_match.diff else read_stdout(name),
    
    2461 2478
                                diff=stdout_match.diff)
    
    2462 2479
     
    
    2463 2480
         check_hp = '-hT' in my_rts_flags and opts.check_hp
    
    ... ... @@ -2567,8 +2584,9 @@ async def interpreter_run(name: TestName,
    2567 2584
         if not stderr_match:
    
    2568 2585
             if _expect_pass(way):
    
    2569 2586
                 dump_stderr_for('comp', name)
    
    2587
    +        # See Note [Redundant output in test results].
    
    2570 2588
             return failBecause('bad stderr',
    
    2571
    -                           stderr=read_stderr(name),
    
    2589
    +                           stderr=None if stderr_match.diff else read_stderr(name),
    
    2572 2590
                                stdout=read_stdout(name),
    
    2573 2591
                                diff=stderr_match.diff)
    
    2574 2592
         stdout_match = CompareOutput(True) if opts.ignore_stdout else await stdout_ok(name, way)
    
    ... ... @@ -2577,7 +2595,7 @@ async def interpreter_run(name: TestName,
    2577 2595
                 dump_stderr_for('comp', name)
    
    2578 2596
             return failBecause('bad stdout',
    
    2579 2597
                                stderr=read_stderr(name),
    
    2580
    -                           stdout=read_stdout(name),
    
    2598
    +                           stdout=None if stdout_match.diff else read_stdout(name),
    
    2581 2599
                                diff=stdout_match.diff)
    
    2582 2600
         return passed()
    
    2583 2601
     
    
    ... ... @@ -2635,13 +2653,13 @@ async def stdout_ok(name: TestName, way: WayName) -> CompareOutput:
    2635 2653
     def read_stdout( name: TestName ) -> str:
    
    2636 2654
         path = in_testdir(name, 'run.stdout')
    
    2637 2655
         if path.exists():
    
    2638
    -        return path.read_text(encoding='UTF-8')
    
    2656
    +        return path.read_text(encoding='UTF-8', errors='replace')
    
    2639 2657
         else:
    
    2640 2658
             return ''
    
    2641 2659
     
    
    2642 2660
     def read_diff( diff_file: Path ) -> Optional[str]:
    
    2643 2661
         if diff_file.exists():
    
    2644
    -        diff = diff_file.read_text()
    
    2662
    +        diff = diff_file.read_text(encoding='UTF-8', errors='replace')
    
    2645 2663
             diff_file.unlink()
    
    2646 2664
             return diff or None
    
    2647 2665
         else:
    
    ... ... @@ -2665,14 +2683,14 @@ async def stderr_ok(name: TestName, way: WayName) -> CompareOutput:
    2665 2683
     def read_comp_stderr( name: TestName ) -> str:
    
    2666 2684
         path = in_testdir(name, 'comp.stderr')
    
    2667 2685
         if path.exists():
    
    2668
    -        return path.read_text(encoding='UTF-8')
    
    2686
    +        return path.read_text(encoding='UTF-8', errors='replace')
    
    2669 2687
         else:
    
    2670 2688
             return ''
    
    2671 2689
     
    
    2672 2690
     def read_stderr_for( phase: str, name: TestName ) -> str:
    
    2673 2691
         path = in_testdir(name, phase + '.stderr')
    
    2674 2692
         if path.exists():
    
    2675
    -        return path.read_text(encoding='UTF-8')
    
    2693
    +        return path.read_text(encoding='UTF-8', errors='replace')
    
    2676 2694
         else:
    
    2677 2695
             return ''
    
    2678 2696
     
    
    ... ... @@ -3571,12 +3589,50 @@ def findTFiles(roots: List[str]) -> Iterator[str]:
    3571 3589
     # -----------------------------------------------------------------------------
    
    3572 3590
     # Output a test summary to the specified file object
    
    3573 3591
     
    
    3574
    -def summary(t: TestRun, file: TextIO, color=False) -> None:
    
    3592
    +def summary(t: TestRun, file: TextIO, color=False, junit_path: Optional[Path]=None) -> None:
    
    3575 3593
     
    
    3576 3594
         file.write('\n')
    
    3595
    +
    
    3596
    +    if t.unexpected_failures:
    
    3597
    +        # Count output blocks rather than results: a test failing in many ways
    
    3598
    +        # collapses to a single block.
    
    3599
    +        groups = groupTestOutput(t.unexpected_failures)
    
    3600
    +        if len(groups) <= MAX_SUMMARY_OUTPUT_TESTS:
    
    3601
    +            printTestOutputSummary(file, groups, color, junit_path)
    
    3602
    +        else:
    
    3603
    +            where = '; see {}'.format(junit_path) if junit_path else ''
    
    3604
    +            header = ('Unexpected failures (more than {}, output omitted{}):'
    
    3605
    +                      .format(MAX_SUMMARY_OUTPUT_TESTS, where))
    
    3606
    +            file.write(colored_if(color, Color.RED, header) + '\n')
    
    3607
    +            printTestInfosSummary(file, t.unexpected_failures)
    
    3608
    +
    
    3609
    +    if t.unexpected_passes:
    
    3610
    +        header = 'Unexpected passes:'
    
    3611
    +        file.write(colored_if(color, Color.RED, header) + '\n')
    
    3612
    +        printTestInfosSummary(file, t.unexpected_passes)
    
    3613
    +
    
    3614
    +    if t.unexpected_stat_failures:
    
    3615
    +        header = 'Unexpected stat failures:'
    
    3616
    +        file.write(colored_if(color, Color.RED, header) + '\n')
    
    3617
    +        printTestInfosSummary(file, t.unexpected_stat_failures)
    
    3618
    +
    
    3619
    +    if t.framework_failures:
    
    3620
    +        header = 'Framework failures:'
    
    3621
    +        file.write(colored_if(color, Color.RED, header) + '\n')
    
    3622
    +        printTestInfosSummary(file, t.framework_failures)
    
    3623
    +
    
    3624
    +    if t.framework_warnings:
    
    3625
    +        header = 'Framework warnings:'
    
    3626
    +        file.write(colored_if(color, Color.YELLOW, header) + '\n')
    
    3627
    +        printTestInfosSummary(file, t.framework_warnings)
    
    3628
    +
    
    3629
    +    if stopping():
    
    3630
    +        warning = 'WARNING: Testsuite run was terminated early'
    
    3631
    +        file.write(colored_if(color, Color.YELLOW, warning) + '\n')
    
    3632
    +
    
    3577 3633
         printUnexpectedTests(file,
    
    3578 3634
             [t.unexpected_passes, t.unexpected_failures,
    
    3579
    -         t.unexpected_stat_failures, t.framework_failures])
    
    3635
    +         t.unexpected_stat_failures, t.framework_failures], color)
    
    3580 3636
     
    
    3581 3637
         if len(t.unexpected_failures) > 0 or \
    
    3582 3638
             len(t.unexpected_stat_failures) > 0 or \
    
    ... ... @@ -3587,7 +3643,8 @@ def summary(t: TestRun, file: TextIO, color=False) -> None:
    3587 3643
             summary_color = Color.GREEN
    
    3588 3644
     
    
    3589 3645
         assert t.start_time is not None
    
    3590
    -    file.write(colored(summary_color, 'SUMMARY') + ' for test run started at '
    
    3646
    +    summary_header = colored_if(color, summary_color, 'SUMMARY')
    
    3647
    +    file.write(summary_header + ' for test run started at '
    
    3591 3648
                    + t.start_time.strftime("%c %Z") + '\n'
    
    3592 3649
                    + str(datetime.datetime.now() - t.start_time).rjust(8)
    
    3593 3650
                    + ' spent to go through\n'
    
    ... ... @@ -3619,46 +3676,107 @@ def summary(t: TestRun, file: TextIO, color=False) -> None:
    3619 3676
                    + ' fragile tests\n'
    
    3620 3677
                    + '\n')
    
    3621 3678
     
    
    3622
    -    if t.unexpected_passes:
    
    3623
    -        file.write('Unexpected passes:\n')
    
    3624
    -        printTestInfosSummary(file, t.unexpected_passes)
    
    3625
    -
    
    3626
    -    if t.unexpected_failures:
    
    3627
    -        file.write('Unexpected failures:\n')
    
    3628
    -        printTestInfosSummary(file, t.unexpected_failures)
    
    3629
    -
    
    3630
    -    if t.unexpected_stat_failures:
    
    3631
    -        file.write('Unexpected stat failures:\n')
    
    3632
    -        printTestInfosSummary(file, t.unexpected_stat_failures)
    
    3633
    -
    
    3634
    -    if t.framework_failures:
    
    3635
    -        file.write('Framework failures:\n')
    
    3636
    -        printTestInfosSummary(file, t.framework_failures)
    
    3637
    -
    
    3638
    -    if t.framework_warnings:
    
    3639
    -        file.write('Framework warnings:\n')
    
    3640
    -        printTestInfosSummary(file, t.framework_warnings)
    
    3641
    -
    
    3642
    -    if stopping():
    
    3643
    -        file.write('WARNING: Testsuite run was terminated early\n')
    
    3644
    -
    
    3645
    -def printUnexpectedTests(file: TextIO, testInfoss):
    
    3679
    +def printUnexpectedTests(file: TextIO, testInfoss, color=False):
    
    3646 3680
         unexpected = set(result.testname
    
    3647 3681
                          for testInfos in testInfoss
    
    3648 3682
                          for result in testInfos
    
    3649 3683
                          if not result.testname.endswith('.T'))
    
    3650 3684
         if unexpected:
    
    3651
    -        file.write('Unexpected results from:\n')
    
    3685
    +        header = 'Unexpected results from:'
    
    3686
    +        file.write(colored_if(color, Color.RED, header) + '\n')
    
    3652 3687
             file.write('TEST="' + ' '.join(sorted(unexpected)) + '"\n')
    
    3653 3688
             file.write('\n')
    
    3654 3689
     
    
    3690
    +# Per-stream cap on a failing test's output repeated in the final summary.
    
    3691
    +MAX_SUMMARY_OUTPUT_LINES = 100
    
    3692
    +
    
    3693
    +# Above this many output blocks, skip repeating output entirely: the dump
    
    3694
    +# would drown out the summary.
    
    3695
    +MAX_SUMMARY_OUTPUT_TESTS = 20
    
    3696
    +
    
    3697
    +# Note [Redundant output in test results]
    
    3698
    +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    3699
    +# A failing test result carries up to three pieces of output: `diff`, `stdout`
    
    3700
    +# and `stderr`. For an output mismatch these overlap: the diff's `+` lines are
    
    3701
    +# the very stream that mismatched, normalised. Reporting both would print the
    
    3702
    +# same text twice, so the mismatching stream is dropped at the call sites in
    
    3703
    +# favour of the diff, which additionally shows what was expected. The *other*
    
    3704
    +# stream is kept: on a stdout mismatch, stderr is independent context.
    
    3705
    +#
    
    3706
    +# The drop is conditional on there being a diff at all: compare_outputs only
    
    3707
    +# runs `diff` when config.verbose >= 1, so under -v0 the stream is the only
    
    3708
    +# output there is.
    
    3709
    +#
    
    3710
    +# Note that, since the drop happens at result construction, it also affects the
    
    3711
    +# JUnit report (junit.py).
    
    3712
    +
    
    3713
    +def strip_diff_header(diff: Optional[str]) -> Optional[str]:
    
    3714
    +    # Drop diff(1)'s ---/+++ lines: they name normalised files in the test
    
    3715
    +    # directory and carry timestamps, which would also keep otherwise
    
    3716
    +    # identical failures from being grouped.
    
    3717
    +    if diff is None:
    
    3718
    +        return None
    
    3719
    +    lines = diff.split('\n')
    
    3720
    +    if len(lines) >= 2 and lines[0].startswith('--- ') and lines[1].startswith('+++ '):
    
    3721
    +        return '\n'.join(lines[2:])
    
    3722
    +    return diff
    
    3723
    +
    
    3724
    +def sorted_results(testInfos: List[TestResult]) -> List[TestResult]:
    
    3725
    +    return sorted(testInfos, key=lambda r: (r.testname.lower(), r.directory, r.way))
    
    3726
    +
    
    3727
    +# A failure-output block: a representative result, its header-stripped diff,
    
    3728
    +# and the ways that share it.
    
    3729
    +OutputGroup = Tuple[TestResult, Optional[str], List[WayName]]
    
    3730
    +
    
    3731
    +# Tests that fail identically in several ways (e.g. normal and g1) share one
    
    3732
    +# output block, with the ways collected in the header.
    
    3733
    +def groupTestOutput(testInfos: List[TestResult]) -> List[OutputGroup]:
    
    3734
    +    # Relies on dicts preserving insertion order.
    
    3735
    +    groups = {} # type: Dict[Tuple, OutputGroup]
    
    3736
    +    for result in sorted_results(testInfos):
    
    3737
    +        diff = strip_diff_header(result.diff)
    
    3738
    +        key = (result.testname, result.directory, result.reason,
    
    3739
    +               diff, result.stdout, result.stderr)
    
    3740
    +        groups.setdefault(key, (result, diff, []))[2].append(result.way)
    
    3741
    +    return list(groups.values())
    
    3742
    +
    
    3743
    +def printTestOutputSummary(file: TextIO,
    
    3744
    +                           groups: List[OutputGroup],
    
    3745
    +                           color: bool=False,
    
    3746
    +                           junit_path: Optional[Path]=None) -> None:
    
    3747
    +    # Repeat failing tests' captured output in the summary, so one needn't
    
    3748
    +    # hunt for it earlier in a possibly very long log; see #16720.
    
    3749
    +    header = '=====> Unexpected failures output summary'
    
    3750
    +    file.write(colored_if(color, Color.RED, header) + '\n\n')
    
    3751
    +
    
    3752
    +    where = ', see {}'.format(junit_path) if junit_path else ''
    
    3753
    +    for result, diff, ways in groups:
    
    3754
    +        header = '=====> {}({}) ({}) [{}]'.format(
    
    3755
    +            result.testname, ', '.join(ways), result.directory + os.sep, result.reason)
    
    3756
    +        file.write(colored_if(color, Color.RED, header) + '\n')
    
    3757
    +        # See Note [Redundant output in test results] for why these don't overlap.
    
    3758
    +        for label, contents in [('Output diff (expected vs actual):', diff),
    
    3759
    +                                ('Captured stdout:', result.stdout),
    
    3760
    +                                ('Captured stderr:', result.stderr)]:
    
    3761
    +            if contents and contents.strip():
    
    3762
    +                lines = contents.rstrip('\n').split('\n')
    
    3763
    +                if len(lines) > MAX_SUMMARY_OUTPUT_LINES:
    
    3764
    +                    omitted = len(lines) - MAX_SUMMARY_OUTPUT_LINES
    
    3765
    +                    lines = lines[:MAX_SUMMARY_OUTPUT_LINES] \
    
    3766
    +                        + ['... ({} more lines omitted{})'.format(omitted, where)]
    
    3767
    +                s = colored_if(color, Color.CYAN, label) + '\n' \
    
    3768
    +                    + ''.join(l + '\n' for l in lines)
    
    3769
    +                # Test output can contain characters that file's encoding
    
    3770
    +                # cannot represent; replace rather than crash (cf safe_print).
    
    3771
    +                enc = getattr(file, 'encoding', None) or 'utf-8'
    
    3772
    +                file.write(s.encode(enc, errors='replace').decode(enc))
    
    3773
    +    footer = '<===== end of unexpected failures output summary'
    
    3774
    +    file.write(colored_if(color, Color.RED, footer) + '\n\n')
    
    3775
    +
    
    3655 3776
     def printTestInfosSummary(file: TextIO, testInfos):
    
    3656
    -    maxDirLen = max(len(tr.directory) for tr in testInfos)
    
    3657
    -    for result in sorted(testInfos, key=lambda r: (r.testname.lower(), r.way, r.directory)):
    
    3658
    -        directory = result.directory.ljust(maxDirLen)
    
    3659
    -        file.write('   {directory}  {r.testname} [{r.reason}] ({r.way})\n'.format(
    
    3660
    -            r = result,
    
    3661
    -            directory = directory))
    
    3777
    +    for result in sorted_results(testInfos):
    
    3778
    +        path = os.path.join(result.directory, result.testname)
    
    3779
    +        file.write('   {path} [{r.reason}] ({r.way})\n'.format(r=result, path=path))
    
    3662 3780
         file.write('\n')
    
    3663 3781
     
    
    3664 3782
     def modify_lines(s: str, f: Callable[[str], str]) -> str:
    

  • testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
    ... ... @@ -5,8 +5,12 @@ IO error: "Abcde" does not exist
    5 5
     While handling ghc-10.1-inplace:GHC.Utils.Panic.GhcException:
    
    6 6
       |
    
    7 7
       | IO error:  "Abcde" does not exist
    
    8
    +  |
    
    9
    +  | HasCallStack backtrace:
    
    10
    +  |   throw, called at compiler/GHC/Utils/Panic.hs:180:21 in ghc-10.1-inplace:GHC.Utils.Panic
    
    11
    +  |   throwGhcException, called at ghc/GHCi/UI.hs:2851:21 in ghc-bin-10.1.20260801-inplace:GHCi.UI
    
    8 12
     
    
    9 13
     HasCallStack backtrace:
    
    10
    -  throwIO, called at compiler\GHC\Utils\Error.hs:499:19 in ghc-10.1-inplace:GHC.Utils.Error
    
    14
    +  throwIO, called at compiler/GHC/Utils/Error.hs:513:19 in ghc-10.1-inplace:GHC.Utils.Error
    
    11 15
     
    
    12 16
     1

  • testsuite/tests/ghc-e/should_run/ghc-e005.stderr
    ... ... @@ -4,3 +4,8 @@ foo
    4 4
     
    
    5 5
     HasCallStack backtrace:
    
    6 6
       error, called at ghc-e005.hs:12:10 in main:Main
    
    7
    +
    
    8
    +
    
    9
    +HasCallStack backtrace:
    
    10
    +  throwIO, called at ghc\GHCi\UI.hs:1655:31 in ghc-bin-10.1.20260629-inplace:GHCi.UI
    
    11
    +

  • testsuite/tests/saks/should_compile/T18725a.hs
    1
    +{-# LANGUAGE ExplicitForAll, KindSignatures, StandaloneKindSignatures,
    
    2
    +             DataKinds, GADTs #-}
    
    3
    +
    
    4
    +module T18725a where
    
    5
    +
    
    6
    +import Data.Kind (Type)
    
    7
    +
    
    8
    +type U :: Type
    
    9
    +data U where P :: forall u. E u -> U
    
    10
    +data E (u :: U)

  • testsuite/tests/saks/should_compile/all.T
    ... ... @@ -35,6 +35,7 @@ test('T16726', normal, compile, [''])
    35 35
     test('T16731', normal, compile, [''])
    
    36 36
     test('T16721', normal, ghci_script, ['T16721.script'])
    
    37 37
     test('T16756a', normal, compile, [''])
    
    38
    +test('T18725a', normal, compile, [''])
    
    38 39
     
    
    39 40
     test('saks027', req_th, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
    
    40 41
     test('saks028', req_th, compile, [''])
    

  • testsuite/tests/saks/should_fail/T18725b.hs
    1
    +{-# LANGUAGE ExplicitForAll, KindSignatures, StandaloneKindSignatures,
    
    2
    +             DataKinds, GADTs #-}
    
    3
    +
    
    4
    +module T18725b where
    
    5
    +
    
    6
    +-- type U :: Type      -- Rejected without the sig
    
    7
    +data U where P :: forall u. E u -> U
    
    8
    +data E (u :: U)

  • testsuite/tests/saks/should_fail/T18725b.stderr
    1
    +T18725b.hs:8:14: error: [GHC-85413]
    
    2
    +    • Type constructor ‘U’ cannot be used here
    
    3
    +        (it is defined and used in the same recursive group)
    
    4
    +    • In the kind ‘U’
    
    5
    +      In the data type declaration for ‘E’
    
    6
    +

  • testsuite/tests/saks/should_fail/all.T
    ... ... @@ -38,3 +38,5 @@ test('T18863d', normal, compile_fail, [''])
    38 38
     test('T20916', normal, compile_fail, [''])
    
    39 39
     test('saks018-fail', normal, compile_fail, [''])
    
    40 40
     test('saks021-fail', normal, compile_fail, [''])
    
    41
    +test('T18725b', normal, compile_fail, [''])
    
    42
    +

  • testsuite/tests/th/T20902.hs
    1
    +{-# LANGUAGE TemplateHaskell #-}
    
    2
    +
    
    3
    +module T20902 where
    
    4
    +
    
    5
    +import Language.Haskell.TH
    
    6
    +
    
    7
    +data T = FU | FUN deriving Show
    
    8
    +
    
    9
    +expr1 = $( conE (mkName "FU") )
    
    10
    +expr2 = $( conE (mkName "FUN") )
    
    11
    +expr3 = $( [| FU |] )
    
    12
    +expr4 = $( [| FUN |] )
    
    13
    +

  • testsuite/tests/th/all.T
    ... ... @@ -651,3 +651,5 @@ test('T26099', normal, compile_fail, [''])
    651 651
     test('T8306_th', only_ways(['ghci']), ghci_script, ['T8306_th.script'])
    
    652 652
     test('T26862_th', only_ways(['ghci']), ghci_script, ['T26862_th.script'])
    
    653 653
     test('T27022', normal, compile_and_run, [''])
    
    654
    +test('T20902', normal, compile, [''])
    
    655
    +

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -1555,26 +1555,26 @@ instance ExactPrint ModuleName where
    1555 1555
     
    
    1556 1556
     -- ---------------------------------------------------------------------
    
    1557 1557
     
    
    1558
    -instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
    
    1559
    -  getAnnotationEntry = entryFromLocatedA
    
    1560
    -  setAnnotationAnchor = setAnchorAn
    
    1558
    +instance ExactPrint (WarningTxt GhcPs) where
    
    1559
    +  getAnnotationEntry _ = NoEntryVal
    
    1560
    +  setAnnotationAnchor a _ _ _ = a
    
    1561 1561
     
    
    1562
    -  exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (WarningTxt src mb_cat ws)) = do
    
    1562
    +  exact (WarningTxt (src, AnnPragma o c (os,cs) l1 l2 t m) mb_cat ws) = do
    
    1563 1563
         o' <- markAnnOpen'' o src "{-# WARNING"
    
    1564 1564
         mb_cat' <- markAnnotated mb_cat
    
    1565 1565
         os' <- markEpToken os
    
    1566 1566
         ws' <- mapM markAnnotated ws
    
    1567 1567
         cs' <- markEpToken cs
    
    1568 1568
         c' <- markEpToken c
    
    1569
    -    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (WarningTxt src mb_cat' ws'))
    
    1569
    +    return (WarningTxt (src, AnnPragma o' c' (os',cs') l1 l2 t m) mb_cat' ws')
    
    1570 1570
     
    
    1571
    -  exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (DeprecatedTxt src ws)) = do
    
    1571
    +  exact (DeprecatedTxt (src, AnnPragma o c (os,cs) l1 l2 t m) ws) = do
    
    1572 1572
         o' <- markAnnOpen'' o src "{-# DEPRECATED"
    
    1573 1573
         os' <- markEpToken os
    
    1574 1574
         ws' <- mapM markAnnotated ws
    
    1575 1575
         cs' <- markEpToken cs
    
    1576 1576
         c' <- markEpToken c
    
    1577
    -    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (DeprecatedTxt src ws'))
    
    1577
    +    return (DeprecatedTxt (src, AnnPragma o' c' (os',cs') l1 l2 t m) ws')
    
    1578 1578
     
    
    1579 1579
     instance ExactPrint (InWarningCategory GhcPs) where
    
    1580 1580
       getAnnotationEntry _ = NoEntryVal