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.

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