Test.hs 3.52 KB
Newer Older
1
module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
2 3 4

import Base
import Expression
5
import GHC
6 7
import Oracles.Flag
import Oracles.Setting
Andrey Mokhov's avatar
Andrey Mokhov committed
8
import Target
9
import Utilities
10

11 12
import System.Environment

13 14
-- TODO: clean up after testing
testRules :: Rules ()
Andrey Mokhov's avatar
Andrey Mokhov committed
15
testRules = do
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
    root <- buildRootRules

    root -/- timeoutPyPath ~> do
        copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPyPath)

    -- TODO windows is still not supported.
    --
    -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
    root -/- timeoutProgPath ~> do
        python <- builderPath Python
        need [root -/- timeoutPyPath]
        let script = unlines
                [ "#!/usr/bin/env sh"
                , "exec " ++ python ++ " $0.py \"$@\""
                ]
        liftIO $ do
            writeFile (root -/- timeoutProgPath) script
        makeExecutable (root -/- timeoutProgPath)

Andrey Mokhov's avatar
Andrey Mokhov committed
35
    "validate" ~> do
36
        needTestBuilders
37
        build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
Andrey Mokhov's avatar
Andrey Mokhov committed
38

39
    "test" ~> do
40 41
        needTestBuilders

42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
        -- Prepare the timeout program.
        need [ root -/- timeoutProgPath ]

        -- 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

        -- Set environment variables for test's Makefile.
        liftIO $ do
            setEnv "MAKE" makePath
            setEnv "TEST_HC" ghcPath
            setEnv "TEST_HC_OPTS" ghcFlags

        -- Execute the test target.
        buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []

66 67
needTestBuilders :: Action ()
needTestBuilders = do
68 69 70 71 72
    needBuilder $ Ghc CompileHs Stage2
    needBuilder $ GhcPkg Update Stage1
    needBuilder Hp2Ps
    needBuilder Hpc
    needBuilder (Hsc2Hs Stage1)
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
-- | Extra flags to send to the Haskell compiler to run tests.
runTestGhcFlags :: Action String
runTestGhcFlags = do
    unregisterised <- flag GhcUnregisterised

    let ifMinGhcVer ver opt = do v <- ghcCanonVersion
                                 if ver <= v then pure opt
                                             else pure ""

    -- Read extra argument for test from command line, like `-fvectorize`.
    ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS")

    -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28
    let ghcExtraFlags = if unregisterised
                           then "-optc-fno-builtin"
                           else ""

    -- Take flags to send to the Haskell compiler from test.mk.
    -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
    unwords <$> sequence
        [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts"
        , pure ghcOpts
        , pure ghcExtraFlags
        , ifMinGhcVer "711" "-fno-warn-missed-specialisations"
        , ifMinGhcVer "711" "-fshow-warning-groups"
        , ifMinGhcVer "801" "-fdiagnostics-color=never"
        , ifMinGhcVer "801" "-fno-diagnostics-show-caret"
        , pure "-dno-debug-output"
        ]

timeoutPyPath :: FilePath
timeoutPyPath = "test/bin/timeout.py"

timeoutProgPath :: FilePath
timeoutProgPath = "test/bin/timeout" <.> exe