2017-08-19 16:16:10 +02:00
|
|
|
|
2016-07-26 01:37:06 +02:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
|
|
|
module GeneratedTests where
|
|
|
|
|
|
|
|
import Test.Tasty
|
|
|
|
import Test.Tasty.HUnit (testCase, (@?=))
|
|
|
|
|
|
|
|
import Data.String
|
2017-02-27 17:43:37 +01:00
|
|
|
import Proto3.Suite.DotProto.Generate
|
2016-07-26 01:37:06 +02:00
|
|
|
|
2017-03-16 18:42:51 +01: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
|
|
|
|
|
2017-08-19 16:16:10 +02:00
|
|
|
compileDotProtoFileOrDie hsTmpDir ["tests"] "simple.proto"
|
2016-07-26 01:37:06 +02:00
|
|
|
|
2017-03-16 18:42:51 +01:00
|
|
|
do exitCode <- proc "tests/simple-server.sh" [hsTmpDir] empty
|
|
|
|
exitCode @?= ExitSuccess
|
2016-07-26 01:37:06 +02:00
|
|
|
|
2017-03-16 18:42:51 +01: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
|
2016-12-12 19:40:23 +01:00
|
|
|
(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
|
|
|
|
|
2017-08-19 16:16:10 +02:00
|
|
|
compileDotProtoFileOrDie hsTmpDir ["tests"] "simple.proto"
|
2016-08-13 00:48:28 +02:00
|
|
|
|
2017-03-16 18:42:51 +01:00
|
|
|
do exitCode <- proc "tests/simple-client.sh" [hsTmpDir] empty
|
|
|
|
exitCode @?= ExitSuccess
|
2016-08-13 00:48:28 +02:00
|
|
|
|
2017-03-16 18:42:51 +01:00
|
|
|
do exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
|
|
|
|
exitCode @?= ExitSuccess
|
2016-08-13 00:48:28 +02:00
|
|
|
|
|
|
|
runManaged $ do
|
|
|
|
serverExitCodeA <- fork
|
2016-12-12 19:40:23 +01:00
|
|
|
(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"
|