[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: configure: Drop unused AC_PROG_CPP

Tue May 16 08:17:38 UTC 2023


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


Commits:
d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00
configure: Drop unused AC_PROG_CPP

In configure, we were calling `AC_PROG_CPP` but never making use of the
$CPP variable it sets or reads.

The issue is $CPP will show up in the --help output of configure,
falsely advertising a configuration option that does nothing.

The reason we don't use the $CPP variable is because HS_CPP_CMD is
expected to be a single command (without flags), but AC_PROG_CPP, when
CPP is unset, will set said variable to something like `/usr/bin/gcc -E`.
Instead, we configure HS_CPP_CMD through $CC.

- - - - -
a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00
rts: fix --disable-large-address-space

This patch moves
ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from
Storage.h to HeapAlloc.h. When --disable-large-address-space is passed
to configure, the code in HeapAlloc.h makes use of these two macros.
Fixes #23385.

- - - - -
bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00
Add -Wmissing-role-annotations

Implements #22702

- - - - -
5165311b by Ben Gamari at 2023-05-16T04:17:29-04:00
base: Export {get,set}ExceptionFinalizer from System.Mem.Weak

As proposed in CLC Proposal #126 [1].

[1]: https://github.com/haskell/core-libraries-committee/issues/126

- - - - -
06aee519 by Ben Gamari at 2023-05-16T04:17:29-04:00
base: Introduce printToHandleFinalizerExceptionHandler

- - - - -


22 changed files:

- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Types/Error/Codes.hs
- configure.ac
- docs/users_guide/using-warnings.rst
- + libraries/base/GHC/IO/Handle/Text.hs-boot
- + libraries/base/GHC/IO/Handle/Types.hs-boot
- libraries/base/GHC/TopHandler.hs
- libraries/base/GHC/Weak.hs
- libraries/base/GHC/Weak/Finalize.hs
- libraries/base/System/Mem/Weak.hs
- libraries/base/changelog.md
- rts/sm/HeapAlloc.h
- rts/sm/Storage.h
- testsuite/tests/linters/notes.stdout
- + testsuite/tests/warnings/should_compile/T22702a.hs
- + testsuite/tests/warnings/should_compile/T22702a.stderr
- + testsuite/tests/warnings/should_compile/T22702b.hs
- testsuite/tests/warnings/should_compile/all.T


Changes:

=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -636,6 +636,7 @@ data WarningFlag =
    | Opt_WarnTypeEqualityRequiresOperators           -- Since 9.4
    | Opt_WarnLoopySuperclassSolve                    -- Since 9.6
    | Opt_WarnTermVariableCapture                     -- Since 9.8
+   | Opt_WarnMissingRoleAnnotations                  -- Since 9.8
    deriving (Eq, Ord, Show, Enum)
 
 -- | Return the names of a WarningFlag
@@ -742,6 +743,7 @@ warnFlagNames wflag = case wflag of
   Opt_WarnTypeEqualityOutOfScope                  -> "type-equality-out-of-scope" :| []
   Opt_WarnLoopySuperclassSolve                    -> "loopy-superclass-solve" :| []
   Opt_WarnTypeEqualityRequiresOperators           -> "type-equality-requires-operators" :| []
+  Opt_WarnMissingRoleAnnotations                  -> "missing-role-annotations" :| []
 
 -- -----------------------------------------------------------------------------
 -- Standard sets of warning options


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2249,7 +2249,8 @@ wWarningFlagsDeps = mconcat [
   warnSpec    Opt_WarnGADTMonoLocalBinds,
   warnSpec    Opt_WarnTypeEqualityOutOfScope,
   warnSpec    Opt_WarnTypeEqualityRequiresOperators,
-  warnSpec    Opt_WarnTermVariableCapture
+  warnSpec    Opt_WarnTermVariableCapture,
+  warnSpec    Opt_WarnMissingRoleAnnotations
  ]
 
 warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1338,6 +1338,9 @@ instance Diagnostic TcRnMessage where
     TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $
       hang (text "A section must be enclosed in parentheses")
          2 (text "thus:" <+> (parens (ppr expr)))
+    TcRnMissingRoleAnnotation name roles -> mkSimpleDecorated $
+      hang (text "Missing role annotation" <> colon)
+         2 (text "type role" <+> ppr name <+> hsep (map ppr roles))
 
     TcRnCapturedTermName tv_name shadowed_term_names
       -> mkSimpleDecorated $
@@ -2547,6 +2550,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnGhciMonadLookupFail {}
       -> ErrorWithoutFlag
+    TcRnMissingRoleAnnotation{}
+      -> WarningWithFlag Opt_WarnMissingRoleAnnotations
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -3226,6 +3231,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnGhciMonadLookupFail {}
       -> noHints
+    TcRnMissingRoleAnnotation{}
+      -> noHints
 
   diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode
   diagnosticCode = constructorCode


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -4168,6 +4168,18 @@ data TcRnMessage where
     -> Maybe [GlobalRdrElt] -- ^ lookup result
     -> TcRnMessage
 
+  {- TcRnMissingRoleAnnotation is a warning that occurs when type declaration
+     doesn't have a role annotatiosn
+
+     Controlled by flags:
+       - Wmissing-role-annotations
+
+     Test cases:
+       T22702
+
+  -}
+  TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage
+
   deriving Generic
 
 -- | Things forbidden in @type data@ declarations.


=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -4976,9 +4976,13 @@ checkValidRoleAnnots role_annots tc
       | isVisibleTyConBinder tvb = Just (role, binderVar tvb)
       | otherwise                = Nothing
 
-    check_roles
-      = whenIsJust role_annot_decl_maybe $
-          \decl@(L loc (RoleAnnotDecl _ _ the_role_annots)) ->
+    check_roles = case role_annot_decl_maybe of
+      Nothing ->
+          setSrcSpan (getSrcSpan name) $
+          -- See Note [Missing role annotations warning]
+          warnIf (not (isClassTyCon tc) && not (null vis_roles)) $
+          TcRnMissingRoleAnnotation name vis_roles
+      Just (decl@(L loc (RoleAnnotDecl _ _ the_role_annots))) ->
           addRoleAnnotCtxt name $
           setSrcSpanA loc $ do
           { role_annots_ok <- xoptM LangExt.RoleAnnotations
@@ -5001,6 +5005,39 @@ checkValidRoleAnnots role_annots tc
     check_no_roles
       = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl
 
+-- Note [Missing role annotations warning]
+--
+-- We warn about missing role annotations for tycons
+-- 1. not type-classes:
+--    type classes are nominal by default, which is most conservative
+--    choice. E.g. we cannot have a type-class with an (accidentally)
+--    phantom or representational type variable, as we can with
+--    data types.
+-- 2. with visible roles
+--
+-- We don't make any exceptions for other data types.
+-- In particular we explicitly warn about omitted (default and common)
+-- representational roles. That is the point of the warning.
+-- For example the default representational role for `Map`s key type parameter
+-- would be wrong, and this warning is there to warn about it,
+-- asking users to be explicit.
+--
+-- If the default roles have been nominal, i.e. as conservative as possible,
+-- the warning would still be valuable, as most types can be `representational`
+-- (c.f. type-classes, which usually cannot).
+--
+-- We don't warn about types with invisible roles only, because users cannot
+-- specify them:
+--
+--    type Foo :: forall {k}. Type
+--    data Foo = Foo Int
+--    type role Foo phantom
+--
+-- is incorrect, GHC complains:
+-- Wrong number of roles listed in role annotation;
+-- Expected 0, got 1:
+--
+
 checkRoleAnnot :: TyVar -> LocatedAn NoEpAnns (Maybe Role) -> Role -> TcM ()
 checkRoleAnnot _  (L _ Nothing)   _  = return ()
 checkRoleAnnot tv (L _ (Just r1)) r2


=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -439,6 +439,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnUnexpectedKindVar"                         = 12875
   GhcDiagnosticCode "TcRnNegativeNumTypeLiteral"                    = 93632
   GhcDiagnosticCode "TcRnUnusedQuantifiedTypeVar"                   = 54180
+  GhcDiagnosticCode "TcRnMissingRoleAnnotation"                     = 65490
 
   GhcDiagnosticCode "TcRnUntickedPromotedThing"                     = 49957
   GhcDiagnosticCode "TcRnIllegalBuiltinSyntax"                      = 39716


=====================================
configure.ac
=====================================
@@ -465,9 +465,6 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0])
 dnl make extensions visible to allow feature-tests to detect them lateron
 AC_USE_SYSTEM_EXTENSIONS
 
-dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`)
-AC_PROG_CPP
-
 # --with-hs-cpp/--with-hs-cpp-flags
 FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs)
 AC_SUBST([HaskellCPPCmd])


=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -2393,6 +2393,28 @@ of ``-W(no-)*``.
     When :ghc-flag:`-Wterm-variable-capture` is enabled, GHC warns against implicit quantification
     that would stop working under ``RequiredTypeArguments``.
 
+.. ghc-flag:: -Wmissing-role-annotations
+    :shortdesc: warn when type declarations don't have role annotations
+    :type: dynamic
+    :reverse: -Wno-role-annotations-signatures
+    :category:
+
+    :since: 9.8
+    :default: off
+
+    .. index::
+         single: roles, missing
+
+    If you would like GHC to check that every data type definition
+    has a :ref:`role annotation <role-annotations>`, use the
+    :ghc-flag:`-Wmissing-role-annotations` option.
+    You can specify the role via :extension:`RoleAnnotations`.
+
+    GHC will not warn about type class definitions with missing role annotations,
+    as their default roles are the strictest: all nominal.
+    In other words the type-class role cannot be accidentally left
+    representational or phantom, which could affected the code correctness.
+
 
 If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.
 It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's


=====================================
libraries/base/GHC/IO/Handle/Text.hs-boot
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.IO.Handle.Text ( hPutStrLn ) where
+
+import GHC.Base (String, IO)
+import {-# SOURCE #-} GHC.IO.Handle.Types (Handle)
+
+hPutStrLn :: Handle -> String -> IO ()


=====================================
libraries/base/GHC/IO/Handle/Types.hs-boot
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.IO.Handle.Types ( Handle ) where
+
+data Handle


=====================================
libraries/base/GHC/TopHandler.hs
=====================================
@@ -84,7 +84,7 @@ runMainIO main =
       main_thread_id <- myThreadId
       weak_tid <- mkWeakThreadId main_thread_id
 
-    --setFinalizerExceptionHandler printToStderrFinalizerExceptionHandler
+      --setFinalizerExceptionHandler (printToHandleFinalizerExceptionHandler stderr)
       -- For the time being, we don't install any exception handler for
       -- Handle finalization. Instead, the user should set one manually.
 


=====================================
libraries/base/GHC/Weak.hs
=====================================
@@ -31,7 +31,8 @@ module GHC.Weak (
         -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by
         -- this handler will be ignored.
         setFinalizerExceptionHandler,
-        getFinalizerExceptionHandler
+        getFinalizerExceptionHandler,
+        printToHandleFinalizerExceptionHandler
     ) where
 
 import GHC.Base


=====================================
libraries/base/GHC/Weak/Finalize.hs
=====================================
@@ -11,6 +11,7 @@ module GHC.Weak.Finalize
       -- this handler will be ignored.
       setFinalizerExceptionHandler
     , getFinalizerExceptionHandler
+    , printToHandleFinalizerExceptionHandler
       -- * Internal
     , runFinalizerBatch
     ) where
@@ -20,6 +21,8 @@ import GHC.Exception
 import GHC.IORef
 import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId)
 import GHC.IO (catchException, unsafePerformIO)
+import {-# SOURCE #-} GHC.IO.Handle.Types (Handle)
+import {-# SOURCE #-} GHC.IO.Handle.Text (hPutStrLn)
 import GHC.Encoding.UTF8 (utf8EncodeByteArray#)
 
 data ByteArray = ByteArray ByteArray#
@@ -79,3 +82,13 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler
 -- @since 4.18.0.0
 setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO ()
 setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler
+
+-- | An exception handler for 'Handle' finalization that prints the error to
+-- the given 'Handle', but doesn't rethrow it.
+--
+-- @since 4.18.0.0
+printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO ()
+printToHandleFinalizerExceptionHandler hdl se =
+    hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ())
+  where
+    msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n"


=====================================
libraries/base/System/Mem/Weak.hs
=====================================
@@ -64,6 +64,15 @@ module System.Mem.Weak (
         mkWeakPair,
         -- replaceFinaliser
 
+        -- * Handling exceptions
+        -- | When an exception is thrown by a finalizer called by the
+        -- garbage collector, GHC calls a global handler which can be set with
+        -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by
+        -- this handler will be ignored.
+        setFinalizerExceptionHandler,
+        getFinalizerExceptionHandler,
+        printToHandleFinalizerExceptionHandler,
+
         -- * A precise semantics
 
         -- $precise


=====================================
libraries/base/changelog.md
=====================================
@@ -14,6 +14,8 @@
   * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions.
       ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98))
   * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88))
+  * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126))
+  * Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126))
   * Implement more members of `instance Foldable (Compose f g)` explicitly.
       ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57))
   * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`.


=====================================
rts/sm/HeapAlloc.h
=====================================
@@ -10,6 +10,14 @@
 
 #include "BeginPrivate.h"
 
+#if defined(THREADED_RTS)
+// needed for HEAP_ALLOCED below
+extern SpinLock gc_alloc_block_sync;
+#endif
+
+#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync)
+#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync)
+
 /* -----------------------------------------------------------------------------
    The HEAP_ALLOCED() test.
 


=====================================
rts/sm/Storage.h
=====================================
@@ -43,15 +43,6 @@ extern Mutex sm_mutex;
 #define ASSERT_SM_LOCK()
 #endif
 
-#if defined(THREADED_RTS)
-// needed for HEAP_ALLOCED below
-extern SpinLock gc_alloc_block_sync;
-#endif
-
-#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync)
-#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync)
-
-
 /* -----------------------------------------------------------------------------
    The write barrier for MVARs and TVARs
    -------------------------------------------------------------------------- */


=====================================
testsuite/tests/linters/notes.stdout
=====================================
@@ -34,6 +34,8 @@ ref    compiler/GHC/Tc/Instance/Family.hs:474:35:     Note [Constrained family i
 ref    compiler/GHC/Tc/Module.hs:711:15:     Note [Extra dependencies from .hs-boot files]
 ref    compiler/GHC/Tc/Solver/Rewrite.hs:1009:7:     Note [Stability of rewriting]
 ref    compiler/GHC/Tc/TyCl.hs:1130:6:     Note [Unification variables need fresh Names]
+ref    compiler/GHC/Tc/TyCl.hs:4982:17:     Note [Missing role annotations warning]
+ref    compiler/GHC/Tc/TyCl.hs:5008:3:     Note [Missing role annotations warning]
 ref    compiler/GHC/Tc/Types.hs:692:33:     Note [Extra dependencies from .hs-boot files]
 ref    compiler/GHC/Tc/Types.hs:1423:47:     Note [Care with plugin imports]
 ref    compiler/GHC/Tc/Types/Constraint.hs:226:34:     Note [NonCanonical Semantics]


=====================================
testsuite/tests/warnings/should_compile/T22702a.hs
=====================================
@@ -0,0 +1,25 @@
+{-# OPTIONS_GHC -Wmissing-role-annotations #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+module T22702a where
+
+import Data.Kind (Type)
+
+-- type with parameters
+-- warns
+type Foo :: Type -> Type -> Type
+data Foo x y = Foo x
+
+-- type without parameters
+-- doesn't warn
+data Quu = Quu1 | Quu2
+
+-- polykinded type
+-- warns, no role for `k`
+type Bar :: (k -> Type) -> k -> Type
+data Bar f a = Bar (f a)
+
+-- type-class may have roles as well
+-- doesn't warn
+class C a where


=====================================
testsuite/tests/warnings/should_compile/T22702a.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T22702a.hs:12:1: warning: [GHC-65490] [-Wmissing-role-annotations]
+    Missing role annotation: type role Foo representational phantom
+
+T22702a.hs:21:1: warning: [GHC-65490] [-Wmissing-role-annotations]
+    Missing role annotation: type role Bar representational nominal


=====================================
testsuite/tests/warnings/should_compile/T22702b.hs
=====================================
@@ -0,0 +1,23 @@
+{-# OPTIONS_GHC -Wmissing-role-annotations #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+module T22702b where
+
+import Data.Kind (Type)
+
+-- type with parameters
+type Foo :: Type -> Type -> Type
+type role Foo representational phantom
+data Foo x y = Foo x
+
+-- type without parameters
+data Quu = Quu1 | Quu2
+
+-- polykinded type
+type Bar :: (k -> Type) -> k -> Type
+type role Bar representational nominal
+data Bar f a = Bar (f a)
+
+-- type-class may have roles as well
+class C a where


=====================================
testsuite/tests/warnings/should_compile/all.T
=====================================
@@ -62,3 +62,5 @@ test('T22759', normal, compile, [''])
 test('T22676', [extra_files(['src'])], multimod_compile, ['src.hs', '-working-dir src -Wmissing-home-modules -v0'])
 test('DodgyImports', normal, compile, ['-Wdodgy-imports'])
 test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports'])
+test('T22702a', normal, compile, [''])
+test('T22702b', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f01c89d582ea6650a53dff88103e46eabbdc38ea...06aee51968e65dbd5ca7cb79702cce7b9c7cda18

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f01c89d582ea6650a53dff88103e46eabbdc38ea...06aee51968e65dbd5ca7cb79702cce7b9c7cda18
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/20230516/3a91718c/attachment-0001.html>
