From 18e5103f0f73570e31421e67e54f1693936f5efd Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Fri, 25 Feb 2022 16:28:23 -0500 Subject: testsuite: More robust library way detection Previously `test.mk` would try to determine whether the dynamic, profiling, and vanilla library ways are available by searching for `PrimOpWrappers.{,dyn_,p_}hi` in directory reported by `ghc-pkg field ghc-prim library-dirs`. However, this is extremely fragile as there is no guarantee that there is only one library directory. To handle the case of multiple `library-dirs` correct we would have to carry out the delicate task of tokenising the directory list (in shell, no less). Since this isn't a task that I am eager to solve, I have rather moved the detection logic into the testsuite driver and instead perform a test compilation in each of the ways. This should be more robust than the previous approach. I stumbled upon this while fixing #20579. --- hadrian/src/Settings/Builders/RunTest.hs | 72 ++------------------------------ testsuite/config/ghc | 41 ++++++++++++++---- testsuite/mk/test.mk | 22 ---------- 3 files changed, 38 insertions(+), 97 deletions(-) diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs index 76dc04133a..33d09737c3 100644 --- a/hadrian/src/Settings/Builders/RunTest.hs +++ b/hadrian/src/Settings/Builders/RunTest.hs @@ -57,7 +57,6 @@ runTestGhcFlags = do data TestCompilerArgs = TestCompilerArgs{ hasDynamicRts, hasThreadedRts :: Bool - , libWays :: Set.Set Way , hasDynamic :: Bool , leadingUnderscore :: Bool , withNativeCodeGen :: Bool @@ -86,7 +85,6 @@ inTreeCompilerArgs stg = do (hasDynamicRts, hasThreadedRts) <- do ways <- interpretInContext (Context stg rts vanilla) getRtsWays return (dynamic `elem` ways, threaded `elem` ways) - libWays <- interpretInContext (Context stg compiler vanilla) getLibraryWays -- MP: We should be able to vary if stage1/stage2 is dynamic, ie a dynamic stage1 -- should be able to built a static stage2? hasDynamic <- flavour >>= dynamicGhcPrograms @@ -126,14 +124,13 @@ ghcConfigPath = "test/ghcconfig" -- | If the compiler is out-of-tree then we have to query the compiler to work out -- facts about it. -outOfTreeCompilerArgs :: String -> Action TestCompilerArgs -outOfTreeCompilerArgs testGhc = do +outOfTreeCompilerArgs :: Action TestCompilerArgs +outOfTreeCompilerArgs = do root <- buildRoot need [root -/- ghcConfigPath] (hasDynamicRts, hasThreadedRts) <- do ways <- testRTSSettings return ("dyn" `elem` ways, "thr" `elem` ways) - libWays <- inferLibraryWays testGhc hasDynamic <- getBooleanSetting TestGhcDynamic leadingUnderscore <- getBooleanSetting TestLeadingUnderscore withNativeCodeGen <- getBooleanSetting TestGhcWithNativeCodeGen @@ -162,9 +159,8 @@ outOfTreeCompilerArgs testGhc = do -- thing assertSameCompilerArgs :: Stage -> Action () assertSameCompilerArgs stg = do - test_ghc <- testCompiler <$> userSetting defaultTestArgs in_args <- inTreeCompilerArgs stg - out_args <- outOfTreeCompilerArgs test_ghc + out_args <- outOfTreeCompilerArgs -- The assertion to check we calculated the right thing when (in_args /= out_args) $ putFailure $ unlines $ [ "Hadrian assertion failure: in-tree arguments don't match out-of-tree arguments." @@ -190,7 +186,7 @@ runTestBuilderArgs = builder Testsuite ? do TestCompilerArgs{..} <- expr $ case stageOfTestCompiler testGhc of Just stg -> inTreeCompilerArgs stg - Nothing -> outOfTreeCompilerArgs testGhc + Nothing -> outOfTreeCompilerArgs -- MP: TODO, these should be queried from the test compiler? bignumBackend <- getBignumBackend @@ -220,8 +216,6 @@ runTestBuilderArgs = builder Testsuite ? do let asBool :: String -> Bool -> String asBool s b = s ++ show b - hasLibWay w = elem w libWays - -- TODO: set CABAL_MINIMAL_BUILD/CABAL_PLUGIN_BUILD mconcat [ arg $ "testsuite/driver/runtests.py" , pure [ "--rootdir=" ++ testdir | testdir <- rootdirs ] @@ -256,9 +250,6 @@ runTestBuilderArgs = builder Testsuite ? do , arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags , arg "-e", arg $ asBool "ghc_with_dynamic_rts=" (hasDynamicRts) , arg "-e", arg $ asBool "ghc_with_threaded_rts=" (hasThreadedRts) - , arg "-e", arg $ asBool "config.have_vanilla=" (hasLibWay vanilla) - , arg "-e", arg $ asBool "config.have_dynamic=" (hasLibWay dynamic) - , arg "-e", arg $ asBool "config.have_profiling=" (hasLibWay profiling) , arg "-e", arg $ asBool "config.have_fast_bignum=" (bignumBackend /= "native" && not bignumCheck) , arg "-e", arg $ asBool "ghc_with_smp=" withSMP @@ -360,58 +351,3 @@ setTestSpeed :: TestSpeed -> String setTestSpeed TestSlow = "0" setTestSpeed TestNormal = "1" setTestSpeed TestFast = "2" - --- | The purpose of this function is, given a compiler --- (stage 1, 2, 3 or an external one), to infer the ways --- that the libraries have been built in. --- --- While we have this data readily available for in-tree compilers --- that we build (through the 'Flavour'), that is not the case for --- out-of-tree compilers that we may want to test, as is the case when --- we are running './validate --hadrian' (it packages up a binary --- distribution, installs it somewhere near and tests it). --- --- We therefore proceed in a way that works regardless of whether we are --- dealing with an in-tree compiler or not: we ask the GHC's install --- ghc-pkg to give us the library directory of its @ghc-prim@ package and --- look at what ways are available for the interface file of the --- @GHC.PrimopWrappers@ module, like the Make build system does in --- @testsuite\/mk\/test.mk@ to compute @HAVE_DYNAMIC@, @HAVE_VANILLA@ --- and @HAVE_PROFILING@: --- --- - if we find @PrimopWrappers.hi@, we have the vanilla way; --- - if we find @PrimopWrappers.dyn_hi@, we have the dynamic way; --- - if we find @PrimopWrappers.p_hi@, we have the profiling way. -inferLibraryWays :: String -> Action (Set.Set Way) -inferLibraryWays compiler = do - bindir <- getBinaryDirectory compiler - Stdout ghcPrimLibdirDirty <- cmd - [bindir "ghc-pkg" <.> exe] - ["field", "ghc-prim", "library-dirs", "--simple-output"] - let ghcPrimLibdir = fixup ghcPrimLibdirDirty - ways <- Set.fromList . catMaybes <$> traverse (lookForWay ghcPrimLibdir) candidateWays - return ways - - where lookForWay dir (hifile, w) = do - exists <- doesFileExist (dir -/- hifile) - if exists then return (Just w) else return Nothing - - candidateWays = - [ ("GHC/PrimopWrappers.hi", vanilla) - , ("GHC/PrimopWrappers.dyn_hi", dynamic) - , ("GHC/PrimopWrappers.p_hi", profiling) - ] - - -- If the ghc is in a directory with spaces in a path component, - -- 'dir' is prefixed and suffixed with double quotes. - -- In all cases, there is a \n at the end. - -- This function cleans it all up. - fixup = removeQuotes . removeNewline - - removeNewline path - | "\n" `isSuffixOf` path = init path - | otherwise = path - - removeQuotes path - | "\"" `isPrefixOf` path && "\"" `isSuffixOf` path = tail (init path) - | otherwise = path diff --git a/testsuite/config/ghc b/testsuite/config/ghc index d33101fef8..79dd1b0294 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -37,10 +37,6 @@ if ghc_with_native_codegen: config.compile_ways.append('optasm') config.run_ways.append('optasm') -if config.have_profiling: - config.compile_ways.append('profasm') - config.run_ways.append('profasm') - if config.have_interp: config.run_ways.append('ghci') @@ -60,9 +56,6 @@ if windows: config.supports_dynamic_hs = False config.stdcxx_impl = 'c++' -if (config.have_profiling and ghc_with_threaded_rts): - config.run_ways.append('profthreaded') - # WinIO I/O manager for Windows if windows: winio_ways = ['winio', 'winio_threaded'] @@ -210,6 +203,40 @@ def get_compiler_info(): # See Note [Replacing backward slashes in config.libdir]. config.libdir = config.libdir.replace('\\', '/') + def test_compile(flags) -> bool: + """ + Check whether GHC can compile in the given way. + This is used as a proxy to determine, e.g., whether + profiled libraries were built. + """ + import tempfile + import textwrap + with tempfile.TemporaryDirectory() as d: + src = Path(d) / 'test.hs' + src.write_text(textwrap.dedent(''' + module Main where + main = putStrLn "Hello World!" + ''')) + p = subprocess.run( + '{} -v0 {} -o test '.format(config.compiler, src) + ' '.join(flags), + shell=True, + cwd=d, + stderr=None if config.verbose >= 2 else subprocess.DEVNULL) + res = p.returncode + return res == 0 + + config.have_vanilla = test_compile([]) + config.have_dynamic = test_compile(['-dynamic']) + config.have_profiling = test_compile(['-prof']) + + if config.have_profiling: + config.compile_ways.append('profasm') + config.run_ways.append('profasm') + + if config.have_profiling and ghc_with_threaded_rts: + config.run_ways.append('profthreaded') + ghc_env['HAVE_PROFILING'] = 'YES' + # See Note [WayFlags] if config.ghc_dynamic: config.ghc_th_way_flags = "-dynamic" diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index dbe03286ce..4728ab400e 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -96,10 +96,6 @@ else RUNTEST_OPTS += -e "config.leading_underscore=False" endif -GHC_PRIM_LIBDIR := $(subst library-dirs: ,,"$(shell "$(GHC_PKG)" field ghc-prim library-dirs --simple-output)") -HAVE_VANILLA := $(shell if [ -f "$(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.hi" ]; then echo YES; else echo NO; fi) -HAVE_DYNAMIC := $(shell if [ -f "$(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.dyn_hi" ]; then echo YES; else echo NO; fi) -HAVE_PROFILING := $(shell if [ -f "$(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.p_hi" ]; then echo YES; else echo NO; fi) HAVE_GDB := $(shell if gdb --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) HAVE_READELF := $(shell if readelf --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) @@ -107,24 +103,6 @@ HAVE_READELF := $(shell if readelf --version > /dev/null 2> /dev/null; then echo # used BIGNUM_GMP := $(shell "$(GHC_PKG)" field ghc-bignum exposed-modules | grep GMP) -ifeq "$(HAVE_VANILLA)" "YES" -RUNTEST_OPTS += -e config.have_vanilla=True -else -RUNTEST_OPTS += -e config.have_vanilla=False -endif - -ifeq "$(HAVE_DYNAMIC)" "YES" -RUNTEST_OPTS += -e config.have_dynamic=True -else -RUNTEST_OPTS += -e config.have_dynamic=False -endif - -ifeq "$(HAVE_PROFILING)" "YES" -RUNTEST_OPTS += -e config.have_profiling=True -else -RUNTEST_OPTS += -e config.have_profiling=False -endif - ifeq "$(filter thr, $(GhcRTSWays))" "thr" RUNTEST_OPTS += -e ghc_with_threaded_rts=True else -- cgit v1.2.1