blob: f5d6990e691605446ddf0bf9b0392861617f5b62 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
module Rules.Test (testRules) where
import System.Environment
import Base
import Expression
import Oracles.Setting
import Packages
import Settings
import Settings.Default
import Settings.Builders.RunTest
import Target
import Utilities
ghcConfigHsPath :: FilePath
ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
ghcConfigProgPath :: FilePath
ghcConfigProgPath = "test/bin/ghc-config"
ghcConfigPath :: FilePath
ghcConfigPath = "test/ghcconfig"
-- TODO: clean up after testing
testRules :: Rules ()
testRules = do
root <- buildRootRules
-- | Using program shipped with testsuite to generate ghcconfig file.
root -/- ghcConfigProgPath ~> do
ghc <- builderPath $ Ghc CompileHs Stage0
createDirectory $ takeDirectory (root -/- ghcConfigProgPath)
cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
-- | TODO : Use input test compiler and not just stage2 compiler.
root -/- ghcConfigPath ~> do
ghcPath <- needFile Stage1 ghc
need [root -/- ghcConfigProgPath]
cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
[ghcPath]
root -/- timeoutPath ~> timeoutProgBuilder
"validate" ~> do
needTestBuilders
build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
"test" ~> do
needTestBuilders
-- TODO : Should we remove the previosly generated config file?
-- Prepare Ghc configuration file for input compiler.
need [root -/- ghcConfigPath, root -/- timeoutPath]
-- TODO This approach doesn't work.
-- Set environment variables for test's Makefile.
env <- sequence
[ builderEnvironment "MAKE" $ Make ""
, builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
, AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
makePath <- builderPath $ Make ""
top <- topDirectory
ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
ghcFlags <- runTestGhcFlags
checkPprPath <- (top -/-) <$> needFile Stage1 checkPpr
annotationsPath <- (top -/-) <$> needFile Stage1 checkApiAnnotations
-- Set environment variables for test's Makefile.
liftIO $ do
setEnv "MAKE" makePath
setEnv "TEST_HC" ghcPath
setEnv "TEST_HC_OPTS" ghcFlags
setEnv "CHECK_PPR" checkPprPath
setEnv "CHECK_API_ANNOTATIONS" annotationsPath
-- Execute the test target.
buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
-- | Build extra programs and libraries required by testsuite
needTestsuitePackages :: Action ()
needTestsuitePackages = do
targets <- mapM (needFile Stage1) =<< testsuitePackages
libPath <- stageLibPath Stage1
iservPath <- needFile Stage1 iserv
need targets
-- | We need to copy iserv bin to lib/bin as this is where testsuite looks
-- | for iserv.
copyFile iservPath $ libPath -/- "bin/ghc-iserv"
-- | Build the timeout program.
-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
timeoutProgBuilder :: Action ()
timeoutProgBuilder = do
root <- buildRoot
windows <- windowsHost
if windows
then do
prog <- programPath =<< programContext Stage1 timeout
copyFile prog (root -/- timeoutPath)
else do
python <- builderPath Python
copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPath <.> "py")
let script = unlines
[ "#!/usr/bin/env sh"
, "exec " ++ python ++ " $0.py \"$@\"" ]
writeFile' (root -/- timeoutPath) script
makeExecutable (root -/- timeoutPath)
needTestBuilders :: Action ()
needTestBuilders = do
needBuilder $ Ghc CompileHs Stage2
needBuilder $ GhcPkg Update Stage1
needBuilder Hpc
needBuilder $ Hsc2Hs Stage1
needTestsuitePackages
needFile :: Stage -> Package -> Action FilePath
needFile stage pkg
-- TODO (Alp): we might sometimes need more than vanilla!
-- This should therefore depend on what test ways
-- we are going to use, I suppose?
| isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
| otherwise = programPath =<< programContext stage pkg
|