Test.hs 4.08 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
8
import Settings
Andrey Mokhov's avatar
Andrey Mokhov committed
9
import Target
10
import Utilities
11

12 13
import System.Environment

14 15
-- TODO: clean up after testing
testRules :: Rules ()
Andrey Mokhov's avatar
Andrey Mokhov committed
16
testRules = do
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
    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
36
    "validate" ~> do
37
        needTestBuilders
38
        build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
Andrey Mokhov's avatar
Andrey Mokhov committed
39

40
    "test" ~> do
41 42
        needTestBuilders

43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
        -- 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 [] []

67 68 69 70 71 72 73
-- | Build extra programs required by testsuite
needTestsuiteBuilders :: Action ()
needTestsuiteBuilders = do
    targets <- mapM (needfile Stage1) =<< testsuitePackages
    need targets
  where
    needfile :: Stage -> Package -> Action FilePath
74 75 76 77 78 79
    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 (vanillaContext stage pkg)
      | otherwise = programPath =<< programContext stage pkg
80

81 82
needTestBuilders :: Action ()
needTestBuilders = do
83 84 85 86
    needBuilder $ Ghc CompileHs Stage2
    needBuilder $ GhcPkg Update Stage1
    needBuilder Hpc
    needBuilder (Hsc2Hs Stage1)
87
    needTestsuiteBuilders
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
-- | 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