Skip to content
Snippets Groups Projects
Commit f87a897b authored by Ben Gamari's avatar Ben Gamari
Browse files

testsuite: Cabalify ghc-config

To ensure that the build benefits from Hadrian's usual logic for building
packages, avoiding #21409.

Closes #21409.

(cherry picked from commit 4d189db9)
parent 181759cc
No related branches found
No related tags found
No related merge requests found
......@@ -5,7 +5,7 @@ module Packages (
checkExact, countDeps,
compareSizes, compiler, containers, deepseq, deriveConstants, directory,
exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline,
ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
libffi, libiserv, mtl, parsec, pretty, primitive, process, remoteIserv, rts,
runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy,
......@@ -37,7 +37,7 @@ ghcPackages =
[ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps
, compareSizes, compiler, containers, deepseq, deriveConstants, directory
, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh
, ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl
, parsec, pretty, process, rts, runGhc, stm, templateHaskell
, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml
......@@ -53,7 +53,7 @@ isGhcPackage = (`elem` ghcPackages)
array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps,
compareSizes, compiler, containers, deepseq, deriveConstants, directory,
exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs,
ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs,
hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, libiserv, mtl,
parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell,
terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml,
......@@ -84,6 +84,7 @@ ghcBignum = lib "ghc-bignum"
ghcBoot = lib "ghc-boot"
ghcBootTh = lib "ghc-boot-th"
ghcCompact = lib "ghc-compact"
ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config"
ghcHeap = lib "ghc-heap"
ghci = lib "ghci"
ghciWrapper = prg "ghci-wrapper" `setPath` "driver/ghci"
......
......@@ -21,12 +21,6 @@ import Utilities
import Context.Type
import qualified System.Directory as IO
ghcConfigHsPath :: FilePath
ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
ghcConfigProgPath :: FilePath
ghcConfigProgPath = "test/bin/ghc-config" <.> exe
checkPprProgPath, checkPprSourcePath :: FilePath
checkPprProgPath = "test/bin/check-ppr" <.> exe
checkPprSourcePath = "utils/check-ppr/Main.hs"
......@@ -109,13 +103,6 @@ testRules = do
testsuiteDeps
-- Using program shipped with testsuite to generate ghcconfig file.
root -/- ghcConfigProgPath %> \_ -> do
ghc0Path <- getCompilerPath "stage0"
-- Invoke via bash to work around #17362.
-- Reasons why this is required are not entirely clear.
cmd ["bash"] ["-c", ghc0Path ++ " " ++ ghcConfigHsPath ++ " -o " ++ (root -/- ghcConfigProgPath)]
-- we need to create wrappers to test the stage1 compiler
-- as the stage1 compiler needs the stage2 libraries
-- to have any hope of passing tests.
......@@ -179,11 +166,10 @@ testRules = do
ghcPath <- getCompilerPath testGhc
whenJust (stageOf testGhc) $ \stg ->
need . (:[]) =<< programPath (Context stg ghc vanilla)
ghcConfigProgPath <- programPath =<< programContext Stage0 ghcConfig
cwd <- liftIO $ IO.getCurrentDirectory
need [makeRelative cwd ghcPath]
need [root -/- ghcConfigProgPath]
cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
[ghcPath]
need [makeRelative cwd ghcPath, ghcConfigProgPath]
cmd [FileStdout $ root -/- ghcConfigPath] ghcConfigProgPath [ghcPath]
root -/- timeoutPath %> \_ -> timeoutProgBuilder
......
......@@ -156,7 +156,7 @@ stage2Packages = stage1Packages
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps ])
testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ])
-- | Default build ways for library packages:
-- * We always build 'vanilla' way.
......
cabal-version: 2.4
name: ghc-config
version: 0.1.0.0
synopsis: A utility used by GHC's testsuite driver to extract information from @ghc --info@.
author: The GHC Developers
maintainer: ghc-devs@haskell.org
executable ghc-config
main-is: ghc-config.hs
build-depends: base, process
default-language: Haskell2010
......@@ -2,6 +2,7 @@ import System.Environment
import System.Process
import Data.Maybe
main :: IO ()
main = do
[ghc] <- getArgs
......
......@@ -246,7 +246,7 @@ endif
# the results, and emits a little .mk file with make bindings for the values.
# This way we cache the results for different values of $(TEST_HC)
$(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs
$(TOP)/ghc-config/ghc-config : $(TOP)/ghc-config/ghc-config.hs
"$(TEST_HC)" --make -o $@ $<
empty=
......@@ -254,8 +254,8 @@ space=$(empty) $(empty)
ifeq "$(ghc_config_mk)" ""
ghc_config_mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk
$(ghc_config_mk) : $(TOP)/mk/ghc-config
$(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ "$$?" != "0" ]; then $(RM) "$@"; exit 1; fi
$(ghc_config_mk) : $(TOP)/ghc-config/ghc-config
$(TOP)/ghc-config/ghc-config "$(TEST_HC)" >"$@"; if [ "$$?" != "0" ]; then $(RM) "$@"; exit 1; fi
# If the ghc-config fails, remove $@, and fail
endif
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment