summaryrefslogtreecommitdiff
path: root/hadrian/src/Rules/Test.hs
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