[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: testsuite: increase timeout of ghc-api tests for wasm32

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Oct 26 10:24:20 UTC 2023



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


Commits:
07ab5cc1 by Cheng Shao at 2023-10-24T15:40:32-04:00
testsuite: increase timeout of ghc-api tests for wasm32

ghc-api tests for wasm32 are more likely to timeout due to the large
wasm module sizes, especially when testing with wasm native tail
calls, given wasmtime's handling of tail call opcodes are suboptimal
at the moment. It makes sense to increase timeout specifically for
these tests on wasm32. This doesn't affect other targets, and for
wasm32 we don't increase timeout for all tests, so not to risk letting
major performance regressions slip through the testsuite.

- - - - -
cb17578f by Greg Steuck at 2023-10-26T06:24:01-04:00
Explicitly require RLIMIT_AS before use in OSMem.c

This is done elsewhere in the source tree. It also suddenly is
required on OpenBSD.

- - - - -
461aa625 by Sylvain Henry at 2023-10-26T06:24:13-04:00
Modularity: modularize external linker

Decouple runLink from DynFlags to allow calling runLink more easily.
This is preliminary work for calling Emscripten's linker (emcc) from
our JavaScript linker.

- - - - -


10 changed files:

- compiler/GHC/Driver/Config/Linker.hs
- compiler/GHC/Linker/Config.hs
- compiler/GHC/Linker/Dynamic.hs
- + compiler/GHC/Linker/External.hs
- compiler/GHC/Linker/Static.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/ghc.cabal.in
- rts/posix/OSMem.c
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/downsweep/all.T


Changes:

=====================================
compiler/GHC/Driver/Config/Linker.hs
=====================================
@@ -1,13 +1,93 @@
 module GHC.Driver.Config.Linker
   ( initFrameworkOpts
-  ) where
+  , initLinkerConfig
+  )
+where
 
+import GHC.Prelude
+import GHC.Platform
 import GHC.Linker.Config
 
 import GHC.Driver.DynFlags
+import GHC.Driver.Session
+
+import Data.List (isPrefixOf)
 
 initFrameworkOpts :: DynFlags -> FrameworkOpts
 initFrameworkOpts dflags = FrameworkOpts
   { foFrameworkPaths    = frameworkPaths    dflags
   , foCmdlineFrameworks = cmdlineFrameworks dflags
   }
+
+-- | Initialize linker configuration from DynFlags
+initLinkerConfig :: DynFlags -> LinkerConfig
+initLinkerConfig dflags =
+  let
+    -- see Note [Solaris linker]
+    ld_filter = case platformOS (targetPlatform dflags) of
+                  OSSolaris2 -> sunos_ld_filter
+                  _          -> id
+    sunos_ld_filter :: String -> String
+    sunos_ld_filter = unlines . sunos_ld_filter' . lines
+    sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
+                          then (ld_prefix x) ++ (ld_postfix x)
+                          else x
+    breakStartsWith x y = break (isPrefixOf x) y
+    ld_prefix = fst . breakStartsWith "Undefined"
+    undefined_found = not . null . snd . breakStartsWith "Undefined"
+    ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
+    ld_postfix = tail . snd . ld_warn_break
+    ld_warning_found = not . null . snd . ld_warn_break
+
+    -- program and arguments
+    --
+    -- `-optl` args come at the end, so that later `-l` options
+    -- given there manually can fill in symbols needed by
+    -- Haskell libraries coming in via `args`.
+    (p,pre_args) = pgm_l dflags
+    post_args    = map Option (getOpts dflags opt_l)
+
+  in LinkerConfig
+    { linkerProgram     = p
+    , linkerOptionsPre  = pre_args
+    , linkerOptionsPost = post_args
+    , linkerTempDir     = tmpDir dflags
+    , linkerFilter      = ld_filter
+    }
+
+{- Note [Solaris linker]
+   ~~~~~~~~~~~~~~~~~~~~~
+  SunOS/Solaris ld emits harmless warning messages about unresolved
+  symbols in case of compiling into shared library when we do not
+  link against all the required libs. That is the case of GHC which
+  does not link against RTS library explicitly in order to be able to
+  choose the library later based on binary application linking
+  parameters. The warnings look like:
+
+Undefined                       first referenced
+  symbol                             in file
+stg_ap_n_fast                       ./T2386_Lib.o
+stg_upd_frame_info                  ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
+newCAF                              ./T2386_Lib.o
+stg_bh_upd_frame_info               ./T2386_Lib.o
+stg_ap_ppp_fast                     ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
+stg_ap_p_fast                       ./T2386_Lib.o
+stg_ap_pp_fast                      ./T2386_Lib.o
+ld: warning: symbol referencing errors
+
+  this is actually coming from T2386 testcase. The emitting of those
+  warnings is also a reason why so many TH testcases fail on Solaris.
+
+  Following filter code is SunOS/Solaris linker specific and should
+  filter out only linker warnings. Please note that the logic is a
+  little bit more complex due to the simple reason that we need to preserve
+  any other linker emitted messages. If there are any. Simply speaking
+  if we see "Undefined" and later "ld: warning:..." then we omit all
+  text between (including) the marks. Otherwise we copy the whole output.
+-}
+


=====================================
compiler/GHC/Linker/Config.hs
=====================================
@@ -2,12 +2,26 @@
 
 module GHC.Linker.Config
   ( FrameworkOpts(..)
-  ) where
+  , LinkerConfig(..)
+  )
+where
 
 import GHC.Prelude
+import GHC.Utils.TmpFs
+import GHC.Utils.CliOption
 
 -- used on darwin only
 data FrameworkOpts = FrameworkOpts
   { foFrameworkPaths    :: [String]
   , foCmdlineFrameworks :: [String]
   }
+
+-- | External linker configuration
+data LinkerConfig = LinkerConfig
+  { linkerProgram     :: String           -- ^ Linker program
+  , linkerOptionsPre  :: [Option]         -- ^ Linker options (before user options)
+  , linkerOptionsPost :: [Option]         -- ^ Linker options (after user options)
+  , linkerTempDir     :: TempDir          -- ^ Temporary directory to use
+  , linkerFilter      :: String -> String -- ^ Output filter
+  }
+


=====================================
compiler/GHC/Linker/Dynamic.hs
=====================================
@@ -20,7 +20,7 @@ import GHC.Unit.Types
 import GHC.Unit.State
 import GHC.Linker.MacOS
 import GHC.Linker.Unit
-import GHC.SysTools.Tasks
+import GHC.Linker.External
 import GHC.Utils.Logger
 import GHC.Utils.TmpFs
 
@@ -98,6 +98,8 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
     pkg_framework_opts <- getUnitFrameworkOpts unit_env (map unitId pkgs)
     let framework_opts = getFrameworkOpts (initFrameworkOpts dflags) platform
 
+    let linker_config = initLinkerConfig dflags
+
     case os of
         OSMinGW32 -> do
             -------------------------------------------------------------
@@ -107,7 +109,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
                             Just s -> s
                             Nothing -> "HSdll.dll"
 
-            runLink logger tmpfs dflags (
+            runLink logger tmpfs linker_config (
                     map Option verbFlags
                  ++ [ Option "-o"
                     , FileOption "" output_fn
@@ -167,7 +169,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
             instName <- case dylibInstallName dflags of
                 Just n -> return n
                 Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
-            runLink logger tmpfs dflags (
+            runLink logger tmpfs linker_config (
                     map Option verbFlags
                  ++ [ Option "-dynamiclib"
                     , Option "-o"
@@ -212,7 +214,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
                                 -- See Note [-Bsymbolic assumptions by GHC]
                                 ["-Wl,-Bsymbolic" | not unregisterised]
 
-            runLink logger tmpfs dflags (
+            runLink logger tmpfs linker_config (
                     map Option verbFlags
                  ++ libmLinkOpts platform
                  ++ [ Option "-o"


=====================================
compiler/GHC/Linker/External.hs
=====================================
@@ -0,0 +1,26 @@
+-- | External ("system") linker
+module GHC.Linker.External
+  ( LinkerConfig(..)
+  , runLink
+  )
+where
+
+import GHC.Prelude
+import GHC.Utils.TmpFs
+import GHC.Utils.Logger
+import GHC.Utils.Error
+import GHC.Utils.CliOption
+import GHC.SysTools.Process
+import GHC.Linker.Config
+
+-- | Run the external linker
+runLink :: Logger -> TmpFs -> LinkerConfig -> [Option] -> IO ()
+runLink logger tmpfs cfg args = traceSystoolCommand logger "linker" $ do
+  let all_args = linkerOptionsPre cfg ++ args ++ linkerOptionsPost cfg
+
+  -- on Windows, mangle environment variables to account for a bug in Windows
+  -- Vista
+  mb_env <- getGccEnv all_args
+
+  runSomethingResponseFile logger tmpfs (linkerTempDir cfg) (linkerFilter cfg)
+    "Linker" (linkerProgram cfg) all_args mb_env


=====================================
compiler/GHC/Linker/Static.hs
=====================================
@@ -26,6 +26,7 @@ import GHC.Linker.MacOS
 import GHC.Linker.Unit
 import GHC.Linker.Dynamic
 import GHC.Linker.ExtraObj
+import GHC.Linker.External
 import GHC.Linker.Windows
 import GHC.Linker.Static.Utils
 
@@ -181,14 +182,12 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
       OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger tmpfs dflags output_fn
       _                                       -> return []
 
-    let link dflags args | platformOS platform == OSDarwin
-                            = do
-                                 GHC.SysTools.runLink logger tmpfs dflags args
-                                 -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
-                                 when (gopt Opt_RPath dflags) $
-                                   GHC.Linker.MacOS.runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
-                         | otherwise
-                            = GHC.SysTools.runLink logger tmpfs dflags args
+    let linker_config = initLinkerConfig dflags
+    let link dflags args = do
+          runLink logger tmpfs linker_config args
+          -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
+          when (platformOS platform == OSDarwin && gopt Opt_RPath dflags) $
+            GHC.Linker.MacOS.runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
 
     link dflags (
                        map GHC.SysTools.Option verbFlags


=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -10,7 +10,6 @@
 module GHC.SysTools.Tasks where
 
 import GHC.Prelude
-import GHC.Platform
 import GHC.ForeignSrcLang
 
 import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound)
@@ -264,68 +263,6 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
                                 ++ ")") ]
                 return Nothing)
 
-
-
-runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
-runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do
-  -- `-optl` args come at the end, so that later `-l` options
-  -- given there manually can fill in symbols needed by
-  -- Haskell libraries coming in via `args`.
-  let (p,args0) = pgm_l dflags
-      optl_args = map Option (getOpts dflags opt_l)
-      args2     = args0 ++ args ++ optl_args
-  mb_env <- getGccEnv args2
-  runSomethingResponseFile logger tmpfs (tmpDir dflags) ld_filter "Linker" p args2 mb_env
-  where
-    ld_filter = case (platformOS (targetPlatform dflags)) of
-                  OSSolaris2 -> sunos_ld_filter
-                  _ -> id
-{-
-  SunOS/Solaris ld emits harmless warning messages about unresolved
-  symbols in case of compiling into shared library when we do not
-  link against all the required libs. That is the case of GHC which
-  does not link against RTS library explicitly in order to be able to
-  choose the library later based on binary application linking
-  parameters. The warnings look like:
-
-Undefined                       first referenced
-  symbol                             in file
-stg_ap_n_fast                       ./T2386_Lib.o
-stg_upd_frame_info                  ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
-newCAF                              ./T2386_Lib.o
-stg_bh_upd_frame_info               ./T2386_Lib.o
-stg_ap_ppp_fast                     ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
-stg_ap_p_fast                       ./T2386_Lib.o
-stg_ap_pp_fast                      ./T2386_Lib.o
-ld: warning: symbol referencing errors
-
-  this is actually coming from T2386 testcase. The emitting of those
-  warnings is also a reason why so many TH testcases fail on Solaris.
-
-  Following filter code is SunOS/Solaris linker specific and should
-  filter out only linker warnings. Please note that the logic is a
-  little bit more complex due to the simple reason that we need to preserve
-  any other linker emitted messages. If there are any. Simply speaking
-  if we see "Undefined" and later "ld: warning:..." then we omit all
-  text between (including) the marks. Otherwise we copy the whole output.
--}
-    sunos_ld_filter :: String -> String
-    sunos_ld_filter = unlines . sunos_ld_filter' . lines
-    sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
-                          then (ld_prefix x) ++ (ld_postfix x)
-                          else x
-    breakStartsWith x y = break (isPrefixOf x) y
-    ld_prefix = fst . breakStartsWith "Undefined"
-    undefined_found = not . null . snd . breakStartsWith "Undefined"
-    ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
-    ld_postfix = tail . snd . ld_warn_break
-    ld_warning_found = not . null . snd . ld_warn_break
-
 -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
 runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
 runMergeObjects logger tmpfs dflags args =


=====================================
compiler/ghc.cabal.in
=====================================
@@ -580,6 +580,7 @@ Library
         GHC.Linker.Config
         GHC.Linker.Deps
         GHC.Linker.Dynamic
+        GHC.Linker.External
         GHC.Linker.ExtraObj
         GHC.Linker.Loader
         GHC.Linker.MacOS


=====================================
rts/posix/OSMem.c
=====================================
@@ -530,7 +530,7 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len)
             (void*)startAddress, (void*)minimumAddress);
     }
 
-#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H)
+#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H) && defined(RLIMIT_AS)
     struct rlimit asLimit;
     /* rlim_t is signed on some platforms, including FreeBSD;
      * explicitly cast to avoid sign compare error */


=====================================
testsuite/tests/ghc-api/all.T
=====================================
@@ -1,3 +1,5 @@
+setTestOpts(when(arch('wasm32'), run_timeout_multiplier(2)))
+
 test('ghcApi', normal, compile_and_run, ['-package ghc'])
 test('T6145', js_broken(22352), makefile_test, ['T6145'])
 test('T8639_api', req_rts_linker,


=====================================
testsuite/tests/ghc-api/downsweep/all.T
=====================================
@@ -1,3 +1,5 @@
+setTestOpts(when(arch('wasm32'), run_timeout_multiplier(2)))
+
 test('PartialDownsweep',
      [ extra_run_opts('"' + config.libdir + '"')
      , ignore_stderr



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dde1d7ff0656269a90b512984fd19de8da21411d...461aa62543484fe3abfaa74275797431099baccf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dde1d7ff0656269a90b512984fd19de8da21411d...461aa62543484fe3abfaa74275797431099baccf
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/20231026/c96841bb/attachment-0001.html>


More information about the ghc-commits mailing list