Skip to content
This repository has been archived by the owner on Aug 2, 2020. It is now read-only.

Getting information of input test compiler #639

Closed
wants to merge 1 commit into from
Closed

Getting information of input test compiler #639

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 15 additions & 4 deletions src/Rules/Test.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath, compilerPath) where

import Base
import CommandLine
import Expression
import GHC
import GHC.Packages (timeout)
Expand All @@ -22,9 +23,8 @@ testRules = do
ghc <- builderPath $ Ghc CompileHs Stage0
cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]

-- | TODO : Use input test compiler and not just stage2 compiler.
root -/- ghcConfigPath ~> do
ghcPath <- needfile Stage1 ghc
ghcPath <- getCompiler
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Strange whitespace

need [ root -/- ghcConfigProgPath]
cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
[ ghcPath ]
Expand Down Expand Up @@ -160,4 +160,15 @@ needfile stage pkg
-- we are going to use, I suppose?
| isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
| otherwise = programPath =<< programContext stage pkg


getCompiler :: Action FilePath
getCompiler = do
args <- userSetting defaultTestArgs
compilerPath $ testCompiler args

-- | Set Test Compiler
compilerPath :: String -> Action FilePath
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm a bit unhappy about using strings here. Could the first argument be turned into a Stage, ideally during parsing of test arguments?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Well, I suppose this could be turned into compilerPath :: Either Stage FilePath -> Action FilePath ?

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@alpmestan Indeed, I missed the last case.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@alpmestan @snowleopard The input still will be a string. I will need to change command line input type as well, but I don't think we will get any major benefit from this, but needlessly complicate the code.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@chitrak7 The benefit is in keeping parsing, string manipulation and associated errors in one place. The rest of the codebase should preferably be strongly typed.

compilerPath "stage0" = setting SystemGhc
compilerPath "stage1" = liftM2 (-/-) topDirectory (needfile Stage0 ghc)
compilerPath "stage2" = liftM2 (-/-) topDirectory (needfile Stage1 ghc)
compilerPath compiler = pure compiler
16 changes: 2 additions & 14 deletions src/Settings/Builders/RunTest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
module Settings.Builders.RunTest (runTestBuilderArgs) where

import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..))
import Context
import Flavour
import GHC
import Hadrian.Utilities
Expand All @@ -17,6 +16,7 @@ oneZero lbl True = lbl ++ "=1"
stringToBool :: String -> Bool
stringToBool "YES" = True
stringToBool "NO" = False
stringToBool _ = error "Cannot parse string"
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Let's rename this function to something more obvious, e.g. parseYesNo? Also I would prefer to make it type safe by returning Maybe Bool and handling possible failures at the use site.

Also, note that we already have something like this here:

https://github.com/snowleopard/hadrian/blob/master/src/Oracles/Flag.hs#L39-L40

As you can see, handling such errors at the use site allows for more informative error messages.


-- | An abstraction to get boolean value of some settings
getBooleanSetting :: TestSetting -> Action Bool
Expand Down Expand Up @@ -102,7 +102,7 @@ getTestArgs :: Args
getTestArgs = do
args <- expr $ userSetting defaultTestArgs
bindir <- expr $ setBinaryDirectory (testCompiler args)
compiler <- expr $ setCompiler (testCompiler args)
compiler <- expr $ compilerPath (testCompiler args)
globalVerbosity <- shakeVerbosity <$> expr getShakeOptions
let configFileArg= ["--config-file=" ++ (testConfigFile args)]
testOnlyArg = case testOnly args of
Expand Down Expand Up @@ -151,13 +151,6 @@ setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0)
setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1)
setBinaryDirectory compiler = pure $ parentPath compiler

-- | Set Test Compiler
setCompiler :: String -> Action FilePath
setCompiler "stage0" = setting SystemGhc
setCompiler "stage1" = liftM2 (-/-) topDirectory (fullpath Stage0 ghc)
setCompiler "stage2" = liftM2 (-/-) topDirectory (fullpath Stage1 ghc)
setCompiler compiler = pure compiler

-- | Set speed for test
setTestSpeed :: TestSpeed -> String
setTestSpeed Fast = "2"
Expand All @@ -169,8 +162,3 @@ setTestSpeed Slow = "0"
parentPath :: String -> String
parentPath path = let upPath = init $ splitOn "/" path
in intercalate "/" upPath

-- | TODO: move to hadrian utilities.
fullpath :: Stage -> Package -> Action FilePath
fullpath stage pkg = programPath =<< programContext stage pkg