[Git][ghc/ghc][ghc-9.8] 3 commits: ghcup-metadata: Fix date modifier (M = minutes, m = month)
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Tue Aug 29 16:11:41 UTC 2023
Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC
Commits:
cfb98b12 by Matthew Pickering at 2023-08-24T14:04:24-04:00
ghcup-metadata: Fix date modifier (M = minutes, m = month)
Fixes #23552
(cherry picked from commit 43b66a132ad0e6b14e191f27c2599832850e05f2)
- - - - -
51479a69 by Alan Zimmerman at 2023-08-24T16:51:56-04:00
EPA: Keep track of "in" token for WarningTxt category
A warning can now be written with a category, e.g.
{-# WARNInG in "x-c" e "d" #-}
Keep track of the location of the 'in' keyword and string, as well as
the original SourceText of the label, in case it uses character escapes.
(cherry picked from commit 818f8aec7c9a6e037c264f1e2cce16960da8fa24)
- - - - -
249aa819 by Ben Gamari at 2023-08-24T16:51:56-04:00
Bump text submodule to 2.1.0-pre
- - - - -
11 changed files:
- .gitlab-ci.yml
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Unit/Module/Warnings.hs
- compiler/Language/Haskell/Syntax/Concrete.hs
- libraries/text
- testsuite/tests/warnings/should_compile/T23465.hs
- testsuite/tests/warnings/should_compile/T23465.stderr
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -1061,7 +1061,7 @@ ghcup-metadata-nightly:
artifacts: false
- job: project-version
script:
- - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml"
+ - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml"
rules:
- if: $NIGHTLY
@@ -1099,7 +1099,7 @@ ghcup-metadata-release:
# No explicit needs for release pipeline as we assume we need everything and everything will pass.
extends: .ghcup-metadata
script:
- - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml"
+ - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml"
rules:
- if: '$RELEASE_JOB == "yes"'
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -1235,7 +1235,7 @@ instance OutputableBndrId p
<+> ppr txt
where
ppr_category = case txt of
- WarningTxt (Just cat) _ _ -> text "in" <+> doubleQuotes (ppr cat)
+ WarningTxt (Just cat) _ _ -> ppr cat
_ -> empty
{-
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -403,7 +403,7 @@ toIfaceWarnings (WarnSome vs ds) = IfWarnSome vs' ds'
ds' = [(occ, toIfaceWarningTxt txt) | (occ, txt) <- ds]
toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
-toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs)
+toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc . iwc_wc . unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs)
toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs)
toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName])
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -590,7 +590,7 @@ fromIfaceWarnings = \case
fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn
fromIfaceWarningTxt = \case
- IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs)
+ IfWarningTxt mb_cat src strs -> WarningTxt (noLoc . fromWarningCategory <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs)
IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs)
fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1986,8 +1986,9 @@ to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
-----------------------------------------------------------------------------
-- Warnings and deprecations (c.f. rules)
-warning_category :: { Maybe (Located WarningCategory) }
- : 'in' STRING { Just (sL1 $2 (mkWarningCategory (getSTRING $2))) }
+warning_category :: { Maybe (Located InWarningCategory) }
+ : 'in' STRING { Just (sLL $1 $> $ InWarningCategory (hsTok' $1) (getSTRINGs $2)
+ (sL1 $2 $ mkWarningCategory (getSTRING $2))) }
| {- empty -} { Nothing }
warnings :: { OrdList (LWarnDecl GhcPs) }
@@ -4494,6 +4495,9 @@ listAsAnchor (L l _:_) = spanAsAnchor (locA l)
hsTok :: Located Token -> LHsToken tok GhcPs
hsTok (L l _) = L (mkTokenLocation l) HsTok
+hsTok' :: Located Token -> Located (HsToken tok)
+hsTok' (L l _) = L l HsTok
+
hsUniTok :: Located Token -> LHsUniToken tok utok GhcPs
hsUniTok t@(L l _) =
L (mkTokenLocation l)
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -300,7 +300,7 @@ rnSrcWarnDecls bndr_set decls'
rnWarningTxt :: WarningTxt GhcPs -> RnM (WarningTxt GhcRn)
rnWarningTxt (WarningTxt mb_cat st wst) = do
- forM_ mb_cat $ \(L loc cat) ->
+ forM_ mb_cat $ \(L _ (InWarningCategory _ _ (L loc cat))) ->
unless (validWarningCategory cat) $
addErrAt loc (TcRnInvalidWarningCategory cat)
wst' <- traverse (traverse rnHsDoc) wst
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -10,10 +11,12 @@
-- | Warnings for a module
module GHC.Unit.Module.Warnings
- ( WarningCategory
+ ( WarningCategory(..)
, mkWarningCategory
, defaultWarningCategory
, validWarningCategory
+ , InWarningCategory(..)
+ , fromWarningCategory
, WarningCategorySet
, emptyWarningCategorySet
@@ -56,6 +59,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Unicode
+import Language.Haskell.Syntax.Concrete (HsToken (HsTok))
import Language.Haskell.Syntax.Extension
import Data.Data
@@ -110,6 +114,15 @@ the possibility of them being infinite.
-}
+data InWarningCategory
+ = InWarningCategory
+ { iwc_in :: !(Located (HsToken "in")),
+ iwc_st :: !SourceText,
+ iwc_wc :: (Located WarningCategory)
+ } deriving Data
+
+fromWarningCategory :: WarningCategory -> InWarningCategory
+fromWarningCategory wc = InWarningCategory (noLoc HsTok) NoSourceText (noLoc wc)
-- See Note [Warning categories]
@@ -184,7 +197,7 @@ deleteWarningCategorySet c (CofiniteWarningCategorySet s) = CofiniteWarningCateg
-- reason/explanation from a WARNING or DEPRECATED pragma
data WarningTxt pass
= WarningTxt
- (Maybe (Located WarningCategory))
+ (Maybe (Located InWarningCategory))
-- ^ Warning category attached to this WARNING pragma, if any;
-- see Note [Warning categories]
(Located SourceText)
@@ -197,7 +210,7 @@ data WarningTxt pass
-- | To which warning category does this WARNING or DEPRECATED pragma belong?
-- See Note [Warning categories].
warningTxtCategory :: WarningTxt pass -> WarningCategory
-warningTxtCategory (WarningTxt (Just (L _ cat)) _ _) = cat
+warningTxtCategory (WarningTxt (Just (L _ (InWarningCategory _ _ (L _ cat)))) _ _) = cat
warningTxtCategory _ = defaultWarningCategory
-- | The message that the WarningTxt was specified to output
@@ -218,16 +231,22 @@ warningTxtSame w1 w2
| WarningTxt {} <- w1, WarningTxt {} <- w2 = True
| otherwise = False
-deriving instance Eq (IdP pass) => Eq (WarningTxt pass)
+deriving instance Eq InWarningCategory
+
+deriving instance (Eq (HsToken "in"), Eq (IdP pass)) => Eq (WarningTxt pass)
deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
+instance Outputable InWarningCategory where
+ ppr (InWarningCategory _ _ wt) = text "in" <+> doubleQuotes (ppr wt)
+
+
instance Outputable (WarningTxt pass) where
ppr (WarningTxt mcat lsrc ws)
= case unLoc lsrc of
NoSourceText -> pp_ws ws
SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
where
- ctg_doc = maybe empty (\ctg -> text "in" <+> doubleQuotes (ppr ctg)) mcat
+ ctg_doc = maybe empty (\ctg -> ppr ctg) mcat
ppr (DeprecatedTxt lsrc ds)
=====================================
compiler/Language/Haskell/Syntax/Concrete.hs
=====================================
@@ -35,6 +35,7 @@ data HsToken (tok :: Symbol) = HsTok
-- avoid a dependency.
data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
+deriving instance Eq (HsToken tok)
deriving instance KnownSymbol tok => Data (HsToken tok)
deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)
=====================================
libraries/text
=====================================
@@ -1 +1 @@
-Subproject commit fe14df3f578cd49cb72555f25c49843a8671dfd2
+Subproject commit 9fc523cef77f02c465afe00a2f4ac67c388f9945
=====================================
testsuite/tests/warnings/should_compile/T23465.hs
=====================================
@@ -1,4 +1,4 @@
module T23465 {-# WaRNING in "x-a" "b" #-} where
-{-# WARNInG in "x-c" e "d" #-}
+{-# WARNInG in "x-c-\72" e "d" #-}
e = e
=====================================
testsuite/tests/warnings/should_compile/T23465.stderr
=====================================
@@ -3,7 +3,7 @@
module T23465
{-# WaRNING in "x-a" "b" #-}
where
-{-# WARNInG in "x-c" e "d" #-}
+{-# WARNInG in "x-c-H" e "d" #-}
e = e
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3e2a69a25cca05549a020adb83e367b421c9b8c...249aa8193e4c5c1ee46ce29b39d2fffa57de7904
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3e2a69a25cca05549a020adb83e367b421c9b8c...249aa8193e4c5c1ee46ce29b39d2fffa57de7904
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230829/cf6b275d/attachment-0001.html>
More information about the ghc-commits
mailing list