Skip to content

Commit

Permalink
End-to-end test discovery.
Browse files Browse the repository at this point in the history
  • Loading branch information
andorp committed Jul 21, 2019
1 parent eb5d87e commit a6b469c
Show file tree
Hide file tree
Showing 16 changed files with 291 additions and 21 deletions.
3 changes: 2 additions & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -38,9 +38,10 @@ script:
- mkdir .output
- stack build --coverage
- stack exec grin-test --coverage
- stack exec grin-end-to-end-test --coverage
- stack exec grin -- grin/grin/sum_simple.grin

after_script:
- travis_retry curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.4.0/shc-linux-x64-8.0.1.tar.bz2 | tar -xj
- stack hpc report --all grin-test.tix grin.tix
- stack hpc report --all grin.tix grin-test.tix grin-end-to-end-test.tix
- ./shc --repo-token=zGXui2BR5EcWhA292bY5ouvTWhZCj2zVU combined custom
30 changes: 18 additions & 12 deletions grin/app/GrinCLI.hs → grin/app/CLI/Lib.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
{-# LANGUAGE LambdaCase #-}
module Main where
module CLI.Lib where

import Control.Monad
import Data.Map (Map(..))
Expand All @@ -21,6 +21,8 @@ import Grin.Parse hiding (value)
import Grin.Nametable as Nametable
import Pipeline.Pipeline



data Options = Options
{ optFiles :: [FilePath]
, optTrans :: [PipelineStep]
Expand Down Expand Up @@ -149,14 +151,18 @@ printGrinWithOpt = flip PrintGrin id <$> option (maybeReader maybeRenderingOpt)
<> help "Print the actual grin code with a given rendering option [simple | with-externals]"
<> metavar "OPT" )

options :: IO Options
options = execParser $ info
(pipelineArgs <**> helper)
(mconcat
[ fullDesc
, progDesc "grin compiler"
, header "grin compiler"
])
options :: [String] -> IO Options
options args = do
let res = execParserPure defaultPrefs
(info
(pipelineArgs <**> helper)
(mconcat
[ fullDesc
, progDesc "grin compiler"
, header "grin compiler"
]))
args
handleParseResult res
where
pipelineArgs = Options
<$> some (argument str (metavar "FILES..."))
Expand Down Expand Up @@ -185,10 +191,10 @@ options = execParser $ info
, help "Save intermediate results in binary format"
])

main :: IO ()
main = do
mainWithArgs :: [String] -> IO ()
mainWithArgs args = do
hSetBuffering stdout NoBuffering
Options files steps outputDir noPrelude quiet loadBinary saveBinary <- options
Options files steps outputDir noPrelude quiet loadBinary saveBinary <- options args
forM_ files $ \fname -> do
(mTypeEnv, program) <- if loadBinary
then do
Expand Down
10 changes: 10 additions & 0 deletions grin/app/CLI/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
module Main where

import System.Environment (getArgs)
import CLI.Lib (mainWithArgs)


main :: IO ()
main = do
args <- getArgs
mainWithArgs args
94 changes: 92 additions & 2 deletions grin/grin.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,7 @@ library

executable grin
hs-source-dirs: app
main-is: GrinCLI.hs
main-is: CLI/Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base >=4.11
, grin
Expand All @@ -197,10 +197,12 @@ executable grin
, optparse-applicative
, directory
, binary
other-modules:
CLI.Lib
default-language: Haskell2010

executable grin-test
hs-source-dirs: test
hs-source-dirs: test, app
main-is: Spec.hs
default-extensions: OverloadedStrings
build-depends: base >=4.11
Expand All @@ -222,6 +224,11 @@ executable grin-test
, ansi-wl-pprint
, directory
, inline-c
, directory-tree
, yaml
, binary
, optparse-applicative
, megaparsec

other-modules:
Transformations.Simplifying.RegisterIntroductionSpec
Expand Down Expand Up @@ -271,8 +278,91 @@ executable grin-test
AbstractInterpretation.SharingSpec
AbstractInterpretation.CreatedBySpec
Test.Hspec.PipelineExample
Test.Hspec.Compiler
CLI.Lib
default-language: Haskell2010

executable grin-end-to-end-test
hs-source-dirs: test, app
main-is: EndToEnd.hs
default-extensions: OverloadedStrings
build-depends: base >=4.11
, containers
, filepath
, functor-infix
, grin
, hspec
, hspec-core
, hspec-discover
, QuickCheck
, deepseq
, vector
, text
, random
, microlens
, transformers
, mtl
, ansi-wl-pprint
, directory
, inline-c
, directory-tree
, yaml
, megaparsec
, binary
, optparse-applicative
other-modules:
Transformations.Simplifying.RegisterIntroductionSpec
Transformations.Simplifying.CaseSimplificationSpec
Transformations.Simplifying.SplitFetchSpec
Transformations.Simplifying.RightHoistFetchSpec
Transformations.Simplifying.VectorisationSpec
Transformations.Simplifying.ProducerNameIntroductionSpec
Transformations.Simplifying.BindingPatternSimplificationSpec
Transformations.Optimising.CaseCopyPropagationSpec
Transformations.Optimising.CopyPropagationSpec
Transformations.Optimising.ConstantFoldingSpec
Transformations.Optimising.ConstantPropagationSpec
Transformations.Optimising.EvaluatedCaseEliminationSpec
Transformations.Optimising.TrivialCaseEliminationSpec
Transformations.Optimising.SparseCaseOptimisationSpec
Transformations.Optimising.UpdateEliminationSpec
Transformations.Optimising.CSESpec
Transformations.Optimising.GeneralizedUnboxingSpec
Transformations.Optimising.ArityRaisingSpec
Transformations.Optimising.SimpleDeadFunctionEliminationSpec
Transformations.Optimising.SimpleDeadParameterEliminationSpec
Transformations.Optimising.SimpleDeadVariableEliminationSpec
Transformations.Optimising.InliningSpec
Transformations.Optimising.CaseHoistingSpec
Transformations.Optimising.DeadDataEliminationSpec
Transformations.Optimising.DeadFunctionEliminationSpec
Transformations.Optimising.DeadParameterEliminationSpec
Transformations.Optimising.DeadVariableEliminationSpec
Transformations.StaticSingleAssignmentSpec
Transformations.BindNormalisationSpec
Transformations.ConfluenceSpec
Transformations.MangleNamesSpec
Samples.SumListSpec
Samples.ArityFullRemoveSpec
LintSpec
TestSpec
PipelineSpec
ParserSpec
PrimOpsSpec
NametableSpec
AbstractInterpretation.HptSpec
AbstractInterpretation.LiveVariableSpec
AbstractInterpretation.EffectTrackingSpec
AbstractInterpretation.IRSpec
AbstractInterpretation.OptimiseAbstractProgramSpec
AbstractInterpretation.SharingSpec
AbstractInterpretation.CreatedBySpec
Test.Hspec.PipelineExample
Test.Hspec.Compiler
CLI.Lib
default-language: Haskell2010


benchmark grin-benchmark
type: exitcode-stdio-1.0
hs-source-dirs: test
Expand Down
50 changes: 50 additions & 0 deletions grin/test-data/dead-data-elimination/length2.grin
Original file line number Diff line number Diff line change
@@ -0,0 +1,50 @@
grinMain = n1 <- pure (CInt 1)
t1 <- store n1
n2 <- pure (CInt 10000)
t2 <- store n2
n3 <- pure (Fupto t1 t2)
t3 <- store n3
n4 <- pure (Flength t3)
t4 <- store n4
n5 <- eval t4
(CInt r') <- pure n5
_prim_int_print r'

upto m n = n6 <- eval m
(CInt m') <- pure n6
n7 <- eval n
(CInt n') <- pure n7
b' <- _prim_int_gt m' n'
if b' then
n8 <- pure (CNil)
pure n8
else
m1' <- _prim_int_add m' 1
n9 <- pure (CInt m1')
m1 <- store n9
n10 <- pure (Fupto m1 n)
p <- store n10
n11 <- pure (CCons m p)
pure n11

length l = l2 <- eval l
case l2 of
(CNil) -> n12 <- pure (CInt 0)
pure n12
(CCons x xs) -> n13 <- length xs
(CInt l') <- pure n13
len <- _prim_int_add l' 1
n14 <- pure (CInt len)
pure n14

eval q = v <- fetch q
case v of
(CInt x'1) -> pure v
(CNil) -> pure v
(CCons y ys) -> pure v
(Fupto a b) -> w <- upto a b
update q w
pure w
(Flength c) -> z <- length c
update q z
pure z
Empty file.
8 changes: 8 additions & 0 deletions grin/test/EndToEnd.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
module Main where

import Test.Hspec (hspec)
import Test.Hspec.Compiler (endToEnd)


main :: IO ()
main = hspec $ endToEnd "./grin/test-data/"
105 changes: 105 additions & 0 deletions grin/test/Test/Hspec/Compiler.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,105 @@
{-# LANGUAGE TypeFamilies, LambdaCase #-}
module Test.Hspec.Compiler where

import Control.Monad (forM, when)
import Test.Hspec.Core.Spec hiding (pending)
import System.Directory.Tree
import System.FilePath.Posix
import System.Directory (doesFileExist)
import Data.Yaml as Yaml
import CLI.Lib (mainWithArgs)
import Data.IORef


data InputFile
= Binary FilePath
| Textual FilePath
deriving (Eq, Show)

inputToFilePath :: InputFile -> FilePath
inputToFilePath = \case
Binary fp -> fp
Textual fp -> fp

data CompilerTest
= PipelineTest
{ compilerInput :: InputFile -- name.grin name.binary
, compilerOptions :: [String] -- input.opts
, compilerExpected :: FilePath -- input.expected
}
| EndToEndTest
{ compilerInput :: InputFile
}

-- TODO: Documentation
evaluatePipelineTest input options expected params actionWith progressCallback = do
result <- newIORef $ Result "" Success
actionWith $ \() -> do
let args = case input of
Binary fp -> [fp, "--load-binary"]
Textual fp -> [fp]
let outFile = inputToFilePath input <.> "out"
mainWithArgs $ args ++ options ++ ["--save-grin=" ++ outFile]
content <- readFile outFile
expected <- readFile expected
when (content /= expected) $ error "BLAH."
readIORef result

-- TODO: Checking run result and bisecting
evaluateEndToEndTest input params actionWith progressCallback = do
result <- newIORef $ Result "" Success
actionWith $ \() -> do
let args = case input of
Binary fp -> [fp, "--load-binary"]
Textual fp -> [fp]
mainWithArgs args
readIORef result

instance Example CompilerTest where
type Arg CompilerTest = ()
evaluateExample compilerTest = case compilerTest of
PipelineTest i o e -> evaluatePipelineTest i o e
EndToEndTest i -> evaluateEndToEndTest i

endToEnd :: FilePath -> Spec
endToEnd dp = describe "End to end tests" $ do
compilerTests <- runIO $ readDirectoryWith createTest dp
treeToSpec $ dirTree compilerTests

createTest :: FilePath -> IO (Maybe (Either String CompilerTest))
createTest fp = do
let isTest = takeExtension fp `elem` [".grin", ".binary"]
case isTest of
False -> pure Nothing
True -> do
hasOpts <- doesFileExist (fp <.> "opts")
hasExpected <- doesFileExist (fp <.> "expected")
case (hasOpts, hasExpected) of
(True, False) -> pure $ Just $ Left $ unwords ["Missing expected result file:", fp <.> "expected"]
(False, True) -> pure $ Just $ Left $ unwords ["Missing options file:", fp <.> "opts"]
(False, False) -> pure $ Just $ Right $ EndToEndTest $ inputFile fp
(True, True) -> Just <$> createPipelineTest fp

inputFile :: FilePath -> InputFile
inputFile fp = case takeExtension fp of
".grin" -> Textual fp
".binary" -> Binary fp

createPipelineTest :: FilePath -> IO (Either String CompilerTest)
createPipelineTest fp = do
eopts <- Yaml.decodeFileWithWarnings (fp <.> "opts")
case eopts of
Left errs -> pure $ Left $ show errs
Right (warnings, opts) -> do
print ("YAML warnings:", warnings)
pure $ Right $ PipelineTest
{ compilerInput = inputFile fp
, compilerOptions = opts
, compilerExpected = fp <.> "expected"
}

treeToSpec :: DirTree (Maybe (Either String CompilerTest)) -> Spec
treeToSpec = \case
Failed name ex -> it name $ pendingWith $ show ex
Dir name contents -> describe name $ mapM_ treeToSpec contents
File name test -> maybe (pure ()) (either (it name . pendingWith) (it name)) test
Original file line number Diff line number Diff line change
Expand Up @@ -63,8 +63,8 @@ spec = do
pipelineSrc before after deadDataEliminationPipeline

it "Length" $ pipeline
"dead-data-elimination/length_before.grin"
"dead-data-elimination/length_after.grin"
"dead-data-elimination/length.grin"
"dead-data-elimination/length.grin.expected"
deadDataEliminationPipeline

it "Multiple fields" $ do
Expand Down Expand Up @@ -410,8 +410,8 @@ spec = do
pipelineSrc before after deadDataEliminationPipeline

it "PNode Before" $ pipeline
"dead-data-elimination/pnode_before.grin"
"dead-data-elimination/pnode_after.grin"
"dead-data-elimination/pnode.grin"
"dead-data-elimination/pnode.grin.expected"
deadDataEliminationPipeline

it "PNode Opt Before" $ do
Expand Down

0 comments on commit a6b469c

Please sign in to comment.