gRPC-haskell/tests/GeneratedTests.hs

78 lines
2 KiB
Haskell
Raw Normal View History

2016-07-26 01:37:06 +02:00
{-# LANGUAGE OverloadedStrings #-}
module GeneratedTests where
import Test.Tasty
import Test.Tasty.HUnit (testCase, (@?=))
import Data.String
import Proto3.Suite.DotProto.Generate
2016-07-26 01:37:06 +02:00
import Turtle hiding (err)
2016-07-26 01:37:06 +02:00
generatedTests :: TestTree
generatedTests = testGroup "Code generator tests"
2016-08-13 00:48:28 +02:00
[ testServerGeneration
, testClientGeneration ]
2016-07-26 01:37:06 +02:00
testServerGeneration :: TestTree
testServerGeneration = testCase "server generation" $ do
mktree hsTmpDir
mktree pyTmpDir
compileDotProtoFileOrDie hsTmpDir ["tests"] "simple.proto"
2016-07-26 01:37:06 +02:00
do exitCode <- proc "tests/simple-server.sh" [hsTmpDir] empty
exitCode @?= ExitSuccess
2016-07-26 01:37:06 +02:00
do exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
exitCode @?= ExitSuccess
2016-07-26 01:37:06 +02:00
runManaged $ do
serverExitCodeA <- fork (shell (hsTmpDir <> "/simple-server") empty)
clientExitCodeA <- fork
(export "PYTHONPATH" pyTmpDir >> shell "tests/test-client.sh" empty)
2016-07-26 01:37:06 +02:00
liftIO $ do
serverExitCode <- liftIO (wait serverExitCodeA)
clientExitCode <- liftIO (wait clientExitCodeA)
serverExitCode @?= ExitSuccess
clientExitCode @?= ExitSuccess
rmtree hsTmpDir
rmtree pyTmpDir
2016-08-13 00:48:28 +02:00
testClientGeneration :: TestTree
testClientGeneration = testCase "client generation" $ do
mktree hsTmpDir
mktree pyTmpDir
compileDotProtoFileOrDie hsTmpDir ["tests"] "simple.proto"
2016-08-13 00:48:28 +02:00
do exitCode <- proc "tests/simple-client.sh" [hsTmpDir] empty
exitCode @?= ExitSuccess
2016-08-13 00:48:28 +02:00
do exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
exitCode @?= ExitSuccess
2016-08-13 00:48:28 +02:00
runManaged $ do
serverExitCodeA <- fork
(export "PYTHONPATH" pyTmpDir >> shell "tests/test-server.sh" empty)
2016-08-13 00:48:28 +02:00
clientExitCodeA <- fork (shell (hsTmpDir <> "/simple-client") empty)
liftIO $ do
serverExitCode <- liftIO (wait serverExitCodeA)
clientExitCode <- liftIO (wait clientExitCodeA)
serverExitCode @?= ExitSuccess
clientExitCode @?= ExitSuccess
rmtree hsTmpDir
rmtree pyTmpDir
2016-07-26 01:37:06 +02:00
hsTmpDir, pyTmpDir :: IsString a => a
hsTmpDir = "tests/tmp"
pyTmpDir = "tests/py-tmp"