[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Restore mingwex dependency on Windows
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Jun 9 12:29:00 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00
Restore mingwex dependency on Windows
This partially reverts some of the changes in !9475 to make `base` and
`ghc-prim` depend on the `mingwex` library on Windows. It also restores the
RTS's stubs for `mingwex`-specific symbols such as `_lock_file`.
This is done because the C runtime provides `libmingwex` nowadays, and
moreoever, not linking against `mingwex` requires downstream users to link
against it explicitly in difficult-to-predict circumstances. Better to always
link against `mingwex` and prevent users from having to do the guesswork
themselves.
See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for
the discussion that led to this.
- - - - -
28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00
RtsSymbols.c: Remove mingwex symbol stubs
As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows,
which means that the RTS no longer needs to declare stubs for the `__mingw_*`
family of symbols. Let's remove these stubs to avoid confusion.
Fixes #23309.
- - - - -
3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00
Consistently use validity checks for TH conversion of data constructors
We were checking that TH-spliced data declarations do not look like this:
```hs
data D :: Type = MkD Int
```
But we were only doing so for `data` declarations' data constructors, not for
`newtype`s, `data instance`s, or `newtype instance`s. This patch factors out
the necessary validity checks into its own `cvtDataDefnCons` function and uses
it in all of the places where it needs to be.
Fixes #22559.
- - - - -
7ae3cfa0 by Matthew Pickering at 2023-06-09T08:28:47-04:00
Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma
This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC
pragma for files with module level scope.
Instead of simple not deleting the files, we also need to remove them
from the TmpFs so they are not deleted later on when all the other files
are deleted.
There are additional complications because you also need to remove the
directory where these files live from the TmpFs so we don't try to
delete those later either.
I added two tests.
1. Tests simply that -keep-tmp-files works at all with a single module
and --make mode.
2. The other tests that temporary files are deleted for other modules
which don't enable -keep-tmp-files.
Fixes #23339
- - - - -
291c57f2 by Matthew Pickering at 2023-06-09T08:28:47-04:00
withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free.
Ticket #23305 reports an error where we were attempting to use the
logger which was created by withDeferredDiagnostics after its scope had
ended.
This problem would have been caught by this patch and a validate build:
```
+*** Exception: Use after free
+CallStack (from HasCallStack):
+ error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make
```
This general issue is tracked by #20981
- - - - -
06642a8b by Matthew Pickering at 2023-06-09T08:28:47-04:00
Don't return complete HscEnv from upsweep
By returning a complete HscEnv from upsweep the logger (as introduced by
withDeferredDiagnostics) was escaping the scope of
withDeferredDiagnostics and hence we were losing error messages.
This is reminiscent of #20981, which also talks about writing errors
into messages after their scope has ended.
See #23305 for details.
- - - - -
e5dd14da by Alexander McKenna at 2023-06-09T08:28:50-04:00
Dump `SpecConstr` specialisations separately
Introduce a `-ddump-spec-constr` flag which debugs specialisations from
`SpecConstr`. These are no longer shown when you use `-ddump-spec`.
- - - - -
27 changed files:
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Utils/TmpFs.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- configure.ac
- docs/users_guide/9.8.1-notes.rst
- docs/users_guide/debugging.rst
- libraries/base/base.cabal
- libraries/ghc-prim/ghc-prim.cabal
- rts/RtsSymbols.c
- testsuite/tests/driver/Makefile
- + testsuite/tests/driver/T23339.hs
- + testsuite/tests/driver/T23339.stdout
- + testsuite/tests/driver/T23339B.hs
- + testsuite/tests/driver/T23339B.stdout
- testsuite/tests/driver/all.T
- testsuite/tests/ghci/prog018/prog018.stdout
- + testsuite/tests/th/T22559a.hs
- + testsuite/tests/th/T22559a.stderr
- + testsuite/tests/th/T22559b.hs
- + testsuite/tests/th/T22559b.stderr
- + testsuite/tests/th/T22559c.hs
- + testsuite/tests/th/T22559c.stderr
- testsuite/tests/th/all.T
Changes:
=====================================
compiler/GHC/Driver/Config/Core/Lint.hs
=====================================
@@ -87,7 +87,7 @@ coreDumpFlag (CoreDoDemand {}) = Just Opt_D_dump_stranal
coreDumpFlag CoreDoCpr = Just Opt_D_dump_cpranal
coreDumpFlag CoreDoWorkerWrapper = Just Opt_D_dump_worker_wrapper
coreDumpFlag CoreDoSpecialising = Just Opt_D_dump_spec
-coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec
+coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec_constr
coreDumpFlag CoreCSE = Just Opt_D_dump_cse
coreDumpFlag CoreDesugar = Just Opt_D_dump_ds_preopt
coreDumpFlag CoreDesugarOpt = Just Opt_D_dump_ds
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -107,6 +107,7 @@ data DumpFlag
| Opt_D_dump_simpl
| Opt_D_dump_simpl_iterations
| Opt_D_dump_spec
+ | Opt_D_dump_spec_constr
| Opt_D_dump_prep
| Opt_D_dump_late_cc
| Opt_D_dump_stg_from_core -- ^ Initial STG (CoreToStg output)
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -782,16 +782,14 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
worker_limit <- liftIO $ mkWorkerLimit dflags
setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
- (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do
+ (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do
hsc_env <- getSession
liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan
- setSession hsc_env1
+ modifySession (addDepsToHscEnv new_deps)
case upsweep_ok of
Failed -> loadFinish upsweep_ok
Succeeded -> do
liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.")
- -- Clean up after ourselves
- liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags
loadFinish upsweep_ok
@@ -1262,14 +1260,13 @@ upsweep
-> Maybe Messager
-> M.Map ModNodeKeyWithUid HomeModInfo
-> [BuildPlan]
- -> IO (SuccessFlag, HscEnv)
+ -> IO (SuccessFlag, [HomeModInfo])
upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = do
(cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan
runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines
res <- collect_result
let completed = [m | Just (Just m) <- res]
- let hsc_env' = addDepsToHscEnv completed hsc_env
-- Handle any cycle in the original compilation graph and return the result
-- of the upsweep.
@@ -1277,10 +1274,10 @@ upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = d
Just mss -> do
let logger = hsc_logger hsc_env
liftIO $ fatalErrorMsg logger (cyclicModuleErr mss)
- return (Failed, hsc_env)
+ return (Failed, [])
Nothing -> do
let success_flag = successIf (all isJust res)
- return (success_flag, hsc_env')
+ return (success_flag, completed)
toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo
toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis])
@@ -2345,18 +2342,21 @@ withDeferredDiagnostics f = do
let action = logMsg logger msgClass srcSpan msg
case msgClass of
MCDiagnostic SevWarning _reason _code
- -> atomicModifyIORef' warnings $ \i -> (action: i, ())
+ -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ())
MCDiagnostic SevError _reason _code
- -> atomicModifyIORef' errors $ \i -> (action: i, ())
+ -> atomicModifyIORef' errors $ \(!i) -> (action: i, ())
MCFatal
- -> atomicModifyIORef' fatals $ \i -> (action: i, ())
+ -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ())
_ -> action
printDeferredDiagnostics = liftIO $
forM_ [warnings, errors, fatals] $ \ref -> do
-- This IORef can leak when the dflags leaks, so let us always
- -- reset the content.
- actions <- atomicModifyIORef' ref $ \i -> ([], i)
+ -- reset the content. The lazy variant is used here as we want to force
+ -- this error if the IORef is ever accessed again, rather than now.
+ -- See #20981 for an issue which discusses this general issue.
+ let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else []
+ actions <- atomicModifyIORef ref $ \i -> (landmine, i)
sequence_ $ reverse actions
MC.bracket
@@ -2432,8 +2432,9 @@ cyclicModuleErr mss
cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()
cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =
- unless (gopt Opt_KeepTmpFiles dflags) $
- liftIO $ cleanCurrentModuleTempFiles logger tmpfs
+ if gopt Opt_KeepTmpFiles dflags
+ then liftIO $ keepCurrentModuleTempFiles logger tmpfs
+ else liftIO $ cleanCurrentModuleTempFiles logger tmpfs
addDepsToHscEnv :: [HomeModInfo] -> HscEnv -> HscEnv
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1425,6 +1425,8 @@ dynamic_flags_deps = [
(setDumpFlag Opt_D_dump_simpl_iterations)
, make_ord_flag defGhcFlag "ddump-spec"
(setDumpFlag Opt_D_dump_spec)
+ , make_ord_flag defGhcFlag "ddump-spec-constr"
+ (setDumpFlag Opt_D_dump_spec_constr)
, make_ord_flag defGhcFlag "ddump-prep"
(setDumpFlag Opt_D_dump_prep)
, make_ord_flag defGhcFlag "ddump-late-cc"
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -277,17 +277,13 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs)
cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
; ksig' <- cvtKind `traverse` ksig
- ; let first_datacon =
- case get_cons_names constr of
- [] -> panic "cvtDec: empty list of constructors"
- c:_ -> c
- ; con' <- cvtConstr first_datacon cNameN constr
+ ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = NewTypeCon con'
+ , dd_cons = con'
, dd_derivs = derivs' }
; returnJustLA $ TyClD noExtField $
DataDecl { tcdDExt = noAnn
@@ -353,17 +349,13 @@ cvtDec (DataFamilyD tc tvs kind)
cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
= do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
; ksig' <- cvtKind `traverse` ksig
- ; let first_datacon =
- case get_cons_names $ head constrs of
- [] -> panic "cvtDec: empty list of constructors"
- c:_ -> c
- ; cons' <- mapM (cvtConstr first_datacon cNameN) constrs
+ ; cons' <- cvtDataDefnCons False ksig $ DataTypeCons False constrs
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = DataTypeCons False cons'
+ , dd_cons = cons'
, dd_derivs = derivs' }
; returnJustLA $ InstD noExtField $ DataFamInstD
@@ -379,17 +371,14 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
= do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
; ksig' <- cvtKind `traverse` ksig
- ; let first_datacon =
- case get_cons_names constr of
- [] -> panic "cvtDec: empty list of constructors"
- c:_ -> c
- ; con' <- cvtConstr first_datacon cNameN constr
+ ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = NewTypeCon con', dd_derivs = derivs' }
+ , dd_cons = con'
+ , dd_derivs = derivs' }
; returnJustLA $ InstD noExtField $ DataFamInstD
{ dfid_ext = noExtField
, dfid_inst = DataFamInstDecl { dfid_eqn =
@@ -498,6 +487,28 @@ cvtGenDataDec :: Bool -> TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis]
-> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause]
-> CvtM (Maybe (LHsDecl GhcPs))
cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs
+ = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
+ ; ksig' <- cvtKind `traverse` ksig
+ ; cons' <- cvtDataDefnCons type_data ksig $
+ DataTypeCons type_data constrs
+ ; derivs' <- cvtDerivs derivs
+ ; let defn = HsDataDefn { dd_ext = noExtField
+ , dd_cType = Nothing
+ , dd_ctxt = mkHsContextMaybe ctxt'
+ , dd_kindSig = ksig'
+ , dd_cons = cons'
+ , dd_derivs = derivs' }
+ ; returnJustLA $ TyClD noExtField $
+ DataDecl { tcdDExt = noAnn
+ , tcdLName = tc', tcdTyVars = tvs'
+ , tcdFixity = Prefix
+ , tcdDataDefn = defn } }
+
+-- Convert a set of data constructors.
+cvtDataDefnCons ::
+ Bool -> Maybe TH.Kind ->
+ DataDefnCons TH.Con -> CvtM (DataDefnCons (LConDecl GhcPs))
+cvtDataDefnCons type_data ksig constrs
= do { let isGadtCon (GadtC _ _ _) = True
isGadtCon (RecGadtC _ _ _) = True
isGadtCon (ForallC _ _ c) = isGadtCon c
@@ -515,27 +526,16 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs
(failWith CannotMixGADTConsWith98Cons)
; unless (isNothing ksig || isGadtDecl)
(failWith KindSigsOnlyAllowedOnGADTs)
- ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
- ; ksig' <- cvtKind `traverse` ksig
; let first_datacon =
- case get_cons_names $ head constrs of
- [] -> panic "cvtGenDataDec: empty list of constructors"
+ case firstDataDefnCon constrs of
+ Nothing -> panic "cvtDataDefnCons: empty list of constructors"
+ Just con -> con
+ first_datacon_name =
+ case get_cons_names first_datacon of
+ [] -> panic "cvtDataDefnCons: data constructor with no names"
c:_ -> c
- ; cons' <- mapM (cvtConstr first_datacon con_name) constrs
-
- ; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExtField
- , dd_cType = Nothing
- , dd_ctxt = mkHsContextMaybe ctxt'
- , dd_kindSig = ksig'
- , dd_cons = DataTypeCons type_data cons'
- , dd_derivs = derivs' }
- ; returnJustLA $ TyClD noExtField $
- DataDecl { tcdDExt = noAnn
- , tcdLName = tc', tcdTyVars = tvs'
- , tcdFixity = Prefix
- , tcdDataDefn = defn } }
+ ; mapM (cvtConstr first_datacon_name con_name) constrs }
----------------
cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
=====================================
compiler/GHC/Utils/TmpFs.hs
=====================================
@@ -13,6 +13,7 @@ module GHC.Utils.TmpFs
, cleanTempDirs
, cleanTempFiles
, cleanCurrentModuleTempFiles
+ , keepCurrentModuleTempFiles
, addFilesToClean
, changeTempFilesLifetime
, newTempName
@@ -172,6 +173,32 @@ cleanTempFiles logger tmpfs
, Set.toList cm_paths ++ Set.toList gs_paths)
remove to_delete
+-- | Keep all the paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@
+-- that have lifetime TFL_CurrentModule. This function is used when `-keep-tmp-files` is
+-- used in an OPTIONS_GHC pragma.
+-- This function removes the temporary file from the TmpFs so we no longer remove
+-- it at the env when cleanTempFiles is called.
+keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO ()
+keepCurrentModuleTempFiles logger tmpfs
+ = mask_
+ $ do to_keep_files <- keep (tmp_files_to_clean tmpfs)
+ to_keep_subdirs <- keep (tmp_subdirs_to_clean tmpfs)
+ -- Remove any folders which contain any files we want to keep from the
+ -- directories we are tracking. A new temporary directory will be created
+ -- the next time a temporary file is needed (by perhaps another module).
+ keepDirs (to_keep_files ++ to_keep_subdirs) (tmp_dirs_to_clean tmpfs)
+ where
+ keepDirs keeps ref = do
+ let keep_dirs = Set.fromList (map takeDirectory keeps)
+ atomicModifyIORef' ref $ \m -> (Map.filter (\fp -> fp `Set.notMember` keep_dirs) m, ())
+
+ keep ref = do
+ to_keep <- atomicModifyIORef' ref $
+ \ptc at PathsToClean{ptcCurrentModule = cm_paths} ->
+ (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths)
+ debugTraceMsg logger 2 (text "Keeping:" <+> hsep (map text to_keep))
+ return to_keep
+
-- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@
-- That have lifetime TFL_CurrentModule.
-- If a file must be cleaned eventually, but must survive a
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -30,7 +30,7 @@ module Language.Haskell.Syntax.Decls (
HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..),
HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys,
NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData,
- isTypeDataDefnCons,
+ isTypeDataDefnCons, firstDataDefnCon,
StandaloneKindSig(..), LStandaloneKindSig,
-- ** Class or type declarations
@@ -1040,6 +1040,11 @@ isTypeDataDefnCons :: DataDefnCons a -> Bool
isTypeDataDefnCons (NewTypeCon _) = False
isTypeDataDefnCons (DataTypeCons is_type_data _) = is_type_data
+-- | Retrieve the first data constructor in a 'DataDefnCons' (if one exists).
+firstDataDefnCon :: DataDefnCons a -> Maybe a
+firstDataDefnCon (NewTypeCon con) = Just con
+firstDataDefnCon (DataTypeCons _ cons) = listToMaybe cons
+
-- | Located data Constructor Declaration
type LConDecl pass = XRec pass (ConDecl pass)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when
=====================================
configure.ac
=====================================
@@ -917,6 +917,9 @@ AC_CHECK_DECLS([program_invocation_short_name], , ,
[#define _GNU_SOURCE 1
#include <errno.h>])
+dnl ** check for mingwex library
+AC_CHECK_LIB([mingwex],[closedir])
+
dnl ** check for math library
dnl Keep that check as early as possible.
dnl as we need to know whether we need libm
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -128,6 +128,10 @@ Compiler
GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 <https://gitlab.haskell.org/ghc/ghc/-/issues/23413>`_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket.
+- The `-ddump-spec` flag has been split into `-ddump-spec` and
+ `-ddump-spec-constr`, allowing only output from the typeclass specialiser or
+ `SpecConstr` to be seen if desired.
+
GHCi
~~~~
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -324,7 +324,15 @@ subexpression elimination pass.
:shortdesc: Dump specialiser output
:type: dynamic
- Dump output of specialisation pass
+ Dump output of typeclass specialisation pass
+
+.. ghc-flag:: -ddump-spec-constr
+ :shortdesc: Dump specialiser output from SpecConstr
+ :type: dynamic
+
+ :since: 9.8.1
+
+ Dump output of the SpecConstr specialisation pass
.. ghc-flag:: -ddump-rules
:shortdesc: Dump rewrite rules
=====================================
libraries/base/base.cabal
=====================================
@@ -398,6 +398,7 @@ Library
if os(windows)
-- Windows requires some extra libraries for linking because the RTS
-- is no longer re-exporting them.
+ -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt.
-- mingw32: Unfortunately required because of a resource leak between
-- mingwex and mingw32. the __math_err symbol is defined in
-- mingw32 which is required by mingwex.
@@ -410,7 +411,7 @@ Library
-- advapi32: provides advanced kernel functions
extra-libraries:
wsock32, user32, shell32, mingw32, kernel32, advapi32,
- ws2_32, shlwapi, ole32, rpcrt4, ntdll
+ mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll
-- Minimum supported Windows version.
-- These numbers can be found at:
-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -68,12 +68,13 @@ Library
-- is no longer re-exporting them (see #11223)
-- ucrt: standard C library. The RTS will automatically include this,
-- but is added for completeness.
+ -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt.
-- mingw32: Unfortunately required because of a resource leak between
-- mingwex and mingw32. the __math_err symbol is defined in
-- mingw32 which is required by mingwex.
-- user32: provides access to apis to modify user components (UI etc)
-- on Windows. Required because of mingw32.
- extra-libraries: user32, mingw32, ucrt
+ extra-libraries: user32, mingw32, mingwex, ucrt
if os(linux)
-- we need libm, but for musl and other's we might need libc, as libm
=====================================
rts/RtsSymbols.c
=====================================
@@ -113,6 +113,26 @@ extern char **environ;
* by the RtsSymbols entry. To avoid this we introduce a horrible special case
* in `ghciInsertSymbolTable`, ensure that `atexit` is never overridden.
*/
+/*
+ * Note [Symbols for MinGW's printf]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * The printf offered by Microsoft's libc implementation, msvcrt, is quite
+ * incomplete, lacking support for even %ull. Consequently mingw-w64 offers its
+ * own implementation which we enable. However, to be thread-safe the
+ * implementation uses _lock_file. This would be fine except msvcrt.dll doesn't
+ * export _lock_file, only numbered versions do (e.g. msvcrt90.dll).
+ *
+ * To work around this mingw-w64 packages a static archive of msvcrt which
+ * includes their own implementation of _lock_file. However, this means that
+ * the archive contains things which the dynamic library does not; consequently
+ * we need to ensure that the runtime linker provides this symbol.
+ *
+ * It's all just so terrible.
+ *
+ * See also:
+ * https://sourceforge.net/p/mingw-w64/wiki2/gnu%20printf/
+ * https://sourceforge.net/p/mingw-w64/discussion/723797/thread/55520785/
+ */
/* Note [_iob_func symbol]
* ~~~~~~~~~~~~~~~~~~~~~~~
* Microsoft in VS2013 to VS2015 transition made a backwards incompatible change
@@ -150,17 +170,17 @@ extern char **environ;
SymI_NeedsProto(__mingw_module_is_dll) \
RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms)) \
RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \
- SymI_HasProto(__mingw_vsnwprintf) \
- /* ^^ Need to figure out why this is needed. */ \
+ RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \
+ RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \
+ RTS_WIN64_ONLY(SymI_HasProto(_errno)) \
+ /* see Note [Symbols for MinGW's printf] */ \
+ SymI_HasProto(_lock_file) \
+ SymI_HasProto(_unlock_file) \
/* See Note [_iob_func symbol] */ \
RTS_WIN64_ONLY(SymI_HasProto_redirect( \
__imp___acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \
RTS_WIN32_ONLY(SymI_HasProto_redirect( \
- __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \
- SymI_HasProto(__mingw_vsnwprintf) \
- /* ^^ Need to figure out why this is needed. */ \
- SymI_HasProto(__mingw_vfprintf) \
- /* ^^ Need to figure out why this is needed. */
+ __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA))
#else
#define RTS_MINGW_ONLY_SYMBOLS /**/
#endif
=====================================
testsuite/tests/driver/Makefile
=====================================
@@ -792,4 +792,21 @@ T22669:
! test -f T22669.o-boot
+T23339:
+ $(RM) T23339.hi
+ $(RM) T23339$(OBJSUFFIX)
+ $(RM) -rf "$(PWD)/tmp"
+ mkdir -p tmp
+ "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339.hs
+ find . -name "*.c" -exec cat {} \; | grep "init__ip_init"
+
+T23339B:
+ $(RM) T23339.hi
+ $(RM) T23339$(OBJSUFFIX)
+ $(RM) -rf "$(PWD)/tmp"
+ mkdir -p tmp
+ "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339B.hs -finfo-table-map
+ # Check that the file is kept and is the right one
+ find . -name "*.c" -exec cat {} \; | grep "init__ip_init"
+
=====================================
testsuite/tests/driver/T23339.hs
=====================================
@@ -0,0 +1,4 @@
+{-# OPTIONS_GHC -keep-tmp-files -finfo-table-map #-}
+module T23339 where
+
+defn = id "T23339"
=====================================
testsuite/tests/driver/T23339.stdout
=====================================
@@ -0,0 +1 @@
+void T23339_init__ip_init (void)
=====================================
testsuite/tests/driver/T23339B.hs
=====================================
@@ -0,0 +1,5 @@
+module T23339B where
+
+import T23339
+
+qux = id "abc"
=====================================
testsuite/tests/driver/T23339B.stdout
=====================================
@@ -0,0 +1 @@
+void T23339_init__ip_init (void)
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -320,3 +320,5 @@ test('T22044', normal, makefile_test, [])
test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"])
test('T21722', normal, compile_fail, ['-fno-show-error-context'])
test('T22669', js_skip, makefile_test, [])
+test('T23339', js_skip, makefile_test, [])
+test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, [])
=====================================
testsuite/tests/ghci/prog018/prog018.stdout
=====================================
@@ -19,4 +19,7 @@ C.hs:6:7: error: [GHC-88464]
Variable not in scope: variableNotInScope :: ()
Failed, two modules loaded.
[3 of 3] Compiling C ( C.hs, interpreted )
+
+C.hs:6:7: error: [GHC-88464]
+ Variable not in scope: variableNotInScope :: ()
Failed, two modules loaded.
=====================================
testsuite/tests/th/T22559a.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T22559a where
+
+import Language.Haskell.TH
+
+$(pure [NewtypeD
+ [] (mkName "D") [] (Just StarT)
+ (NormalC (mkName "MkD")
+ [( Bang NoSourceUnpackedness NoSourceStrictness
+ , ConT ''Int
+ )])
+ []])
=====================================
testsuite/tests/th/T22559a.stderr
=====================================
@@ -0,0 +1,4 @@
+
+T22559a.hs:7:2: error: [GHC-40746]
+ Kind signatures are only allowed on GADTs
+ When splicing a TH declaration: newtype D :: * = MkD GHC.Types.Int
=====================================
testsuite/tests/th/T22559b.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+module T22559b where
+
+import Language.Haskell.TH
+
+data family D
+
+$(pure [DataInstD
+ [] Nothing
+ (ConT (mkName "D")) (Just StarT)
+ [NormalC (mkName "MkD")
+ [( Bang NoSourceUnpackedness NoSourceStrictness
+ , ConT ''Int
+ )]]
+ []])
=====================================
testsuite/tests/th/T22559b.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T22559b.hs:10:2: error: [GHC-40746]
+ Kind signatures are only allowed on GADTs
+ When splicing a TH declaration:
+ data instance D :: * = MkD GHC.Types.Int
=====================================
testsuite/tests/th/T22559c.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+module T22559c where
+
+import Language.Haskell.TH
+
+data family D
+
+$(pure [NewtypeInstD
+ [] Nothing
+ (ConT (mkName "D")) (Just StarT)
+ (NormalC (mkName "MkD")
+ [( Bang NoSourceUnpackedness NoSourceStrictness
+ , ConT ''Int
+ )])
+ []])
=====================================
testsuite/tests/th/T22559c.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T22559c.hs:10:2: error: [GHC-40746]
+ Kind signatures are only allowed on GADTs
+ When splicing a TH declaration:
+ newtype instance D :: * = MkD GHC.Types.Int
=====================================
testsuite/tests/th/all.T
=====================================
@@ -573,3 +573,6 @@ test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_typed5', normal, compile_and_run, [''])
test('T21050', normal, compile_fail, [''])
+test('T22559a', normal, compile_fail, [''])
+test('T22559b', normal, compile_fail, [''])
+test('T22559c', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adb2a55afab372abea97365bf4f97074d921e6f5...e5dd14da021928830d0861907bf6369016f02795
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adb2a55afab372abea97365bf4f97074d921e6f5...e5dd14da021928830d0861907bf6369016f02795
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/20230609/d4db6187/attachment-0001.html>
More information about the ghc-commits
mailing list