Skip to content

Commit 134ff00

Browse files
bladyjokerbladyjoker
authored
Merge pull request #57 from mlabs-haskell/bladyjoker/compiler
Compiler tests
2 parents 521093f + 53df825 commit 134ff00

File tree

9 files changed

+473
-180
lines changed

9 files changed

+473
-180
lines changed

‎lambda-buffers-compiler/app/LambdaBuffers/Compiler/Cli/Compile.hs‎

Lines changed: 9 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,14 @@
11
module LambdaBuffers.Compiler.Cli.Compile (CompileOpts (..), compile) where
22

3-
import Control.Lens (makeLenses, (&), (.~))
4-
import Control.Lens.Getter ((^.))
3+
import Control.Lens (makeLenses, (^.))
54
import Data.ByteString qualified as BS
6-
import Data.ProtoLens (Message (defMessage))
75
import Data.ProtoLens qualified as Pb
86
import Data.ProtoLens.TextFormat qualified as PbText
97
import Data.Text.Lazy qualified as Text
108
import Data.Text.Lazy.IO qualified as Text
119
import LambdaBuffers.Compiler (runCompiler)
12-
import Proto.Compiler (CompilerError, CompilerInput, CompilerOutput)
13-
import Proto.Compiler_Fields (compilerError, compilerResult)
10+
import Proto.Compiler (CompilerInput, CompilerOutput)
11+
import Proto.Compiler_Fields (maybe'compilerError)
1412
import System.FilePath.Lens (extension)
1513

1614
data CompileOpts = CompileOpts
@@ -27,14 +25,13 @@ makeLenses ''CompileOpts
2725
compile :: CompileOpts -> IO ()
2826
compile opts = do
2927
compInp <- readCompilerInput (opts ^. input)
30-
case runCompiler compInp of
31-
Left compErr -> do
32-
putStrLn "Encountered errors during Compilation"
33-
writeCompilerError (opts ^. output) compErr
34-
Right compRes -> do
28+
let compOut = runCompiler compInp
29+
case compOut ^. maybe'compilerError of
30+
Nothing -> do
3531
putStrLn "Compilation succeeded"
36-
writeCompilerOutput (opts ^. output) (defMessage & compilerResult .~ compRes)
37-
return ()
32+
Just _ -> do
33+
putStrLn "Compilation failed"
34+
writeCompilerOutput (opts ^. output) compOut
3835

3936
readCompilerInput :: FilePath -> IO CompilerInput
4037
readCompilerInput fp = do
@@ -48,9 +45,6 @@ readCompilerInput fp = do
4845
return $ PbText.readMessageOrDie content
4946
_ -> error $ "Unknown CompilerInput format " <> ext
5047

51-
writeCompilerError :: FilePath -> CompilerError -> IO ()
52-
writeCompilerError fp err = writeCompilerOutput fp (defMessage & compilerError .~ err)
53-
5448
writeCompilerOutput :: FilePath -> CompilerOutput -> IO ()
5549
writeCompilerOutput fp cr = do
5650
let ext = fp ^. extension

‎lambda-buffers-compiler/lambda-buffers-compiler.cabal‎

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -153,13 +153,16 @@ test-suite tests
153153
hs-source-dirs: test
154154
main-is: Test.hs
155155
build-depends:
156-
, containers
157-
, generic-lens
156+
, containers >=0.6
157+
, generic-lens >=2.2
158+
, hedgehog >=1.2
158159
, lambda-buffers-compiler
159160
, lambda-buffers-compiler-pb >=0.1
161+
, nonempty-containers >=0.3
160162
, proto-lens >=0.7
161163
, QuickCheck >=2.14
162164
, tasty >=1.4
165+
, tasty-hedgehog >=1.4
163166
, tasty-hunit >=0.10
164167
, tasty-quickcheck >=0.10
165168
, text >=1.2
@@ -169,7 +172,10 @@ test-suite tests
169172
Test.KindCheck
170173
Test.KindCheck.Errors
171174
Test.LambdaBuffers.Compiler
172-
Test.LambdaBuffers.Compiler.Gen
175+
Test.LambdaBuffers.Compiler.Coverage
176+
Test.LambdaBuffers.Compiler.Mutation
177+
Test.LambdaBuffers.Compiler.Utils
178+
Test.LambdaBuffers.Compiler.WellFormed
173179
Test.TypeClassCheck
174180
Test.Utils.CompilerInput
175181
Test.Utils.Constructors

‎lambda-buffers-compiler/src/LambdaBuffers/Compiler.hs‎

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,17 @@
11
module LambdaBuffers.Compiler (runCompiler) where
22

3+
import Control.Lens ((&), (.~))
34
import Data.ProtoLens (Message (defMessage))
4-
import LambdaBuffers.Compiler.KindCheck (check_)
5+
import LambdaBuffers.Compiler.KindCheck qualified as KindCheck
56
import LambdaBuffers.Compiler.ProtoCompat.FromProto (
67
runFromProto,
78
toProto,
89
)
9-
import Proto.Compiler (CompilerError, CompilerInput, CompilerResult)
10+
import Proto.Compiler (CompilerInput, CompilerOutput)
11+
import Proto.Compiler_Fields qualified as P
1012

11-
runCompiler :: CompilerInput -> Either CompilerError CompilerResult
13+
runCompiler :: CompilerInput -> CompilerOutput
1214
runCompiler compInp = do
13-
compInp' <- runFromProto compInp
14-
case check_ compInp' of
15-
Left err -> Left $ toProto err
16-
Right _ -> Right defMessage
15+
case runFromProto compInp of
16+
Left err -> defMessage & P.compilerError .~ err
17+
Right compInp' -> toProto $ KindCheck.check compInp'

‎lambda-buffers-compiler/test/Test/LambdaBuffers/Compiler.hs‎

Lines changed: 52 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,62 @@
11
module Test.LambdaBuffers.Compiler (test) where
22

3+
import Control.Lens ((&), (.~))
34
import Data.ProtoLens (Message (defMessage))
5+
import Hedgehog qualified as H
6+
import Hedgehog.Gen qualified as H
47
import LambdaBuffers.Compiler (runCompiler)
5-
import Test.LambdaBuffers.Compiler.Gen (genCompilerInput)
6-
import Test.QuickCheck (forAll, (===))
7-
import Test.Tasty (TestTree, testGroup)
8-
import Test.Tasty.QuickCheck (testProperty)
8+
import Proto.Compiler (CompilerOutput)
9+
import Proto.Compiler_Fields (compilerResult)
10+
import Test.LambdaBuffers.Compiler.Coverage (coverage)
11+
import Test.LambdaBuffers.Compiler.Mutation qualified as Mut
12+
import Test.LambdaBuffers.Compiler.WellFormed (genCompilerInput)
13+
import Test.Tasty (TestTree, adjustOption, testGroup)
14+
import Test.Tasty.HUnit (HasCallStack)
15+
import Test.Tasty.Hedgehog (testProperty)
16+
import Test.Tasty.Hedgehog qualified as H
917

1018
test :: TestTree
1119
test =
12-
testGroup
13-
"Compiler Proto API tests"
14-
[ allCorrectCompInpCompile
15-
]
20+
adjustOption (\_ -> H.HedgehogTestLimit $ Just 1000) $
21+
testGroup
22+
"Compiler API tests"
23+
[ allWellFormedCompInpCompile
24+
, allWellFormedCompInpCompileAfterBenignMut
25+
]
1626

17-
allCorrectCompInpCompile :: TestTree
18-
allCorrectCompInpCompile = testProperty "All correct CompilerInputs must compile" (forAll genCompilerInput (\compInp -> runCompiler compInp === Right defMessage))
27+
compilationOk :: H.MonadTest m => CompilerOutput -> m ()
28+
compilationOk compOut = compOut H.=== (defMessage & compilerResult .~ defMessage)
29+
30+
allWellFormedCompInpCompile :: HasCallStack => TestTree
31+
allWellFormedCompInpCompile =
32+
testProperty
33+
"All well formed CompilerInputs must compile"
34+
( H.property $ do
35+
compInp <- H.forAll genCompilerInput
36+
coverage compInp
37+
compilationOk . runCompiler $ compInp
38+
)
39+
40+
allWellFormedCompInpCompileAfterBenignMut :: HasCallStack => TestTree
41+
allWellFormedCompInpCompileAfterBenignMut =
42+
testProperty
43+
"All well formed CompilerInputs must compile after a benign mutation"
44+
$ H.property
45+
$ do
46+
compInp <- H.forAll genCompilerInput
47+
coverage compInp
48+
mut <-
49+
H.forAll $
50+
H.element
51+
[ Mut.shuffleModules
52+
, Mut.shuffleTyDefs
53+
]
54+
H.collect mut
55+
compInp' <- H.forAllWith (const "") (Mut.mutFn mut compInp)
56+
let compOut = runCompiler compInp
57+
compOut' = runCompiler compInp'
58+
compilationOk compOut
59+
compilationOk compOut'
60+
Mut.mutAssert mut compOut'
1961

2062
-- TODO(bladyjoker): Add error producing mutations.
21-
-- TODO(bladyjoker): Add bening mutations (module, tydef, classdef shuffle).

‎lambda-buffers-compiler/test/Test/LambdaBuffers/Compiler/Coverage.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
module Test.LambdaBuffers.Compiler.Coverage (coverage) where
2+
3+
import Control.Lens ((^.))
4+
import Hedgehog (MonadTest, collect)
5+
import Proto.Compiler (CompilerInput)
6+
import Proto.Compiler_Fields (modules, typeDefs)
7+
8+
-- TODO(bladyjoker): Add stats on TyDef per Module, TyArgs per TyDef etc...
9+
coverage :: MonadTest m => CompilerInput -> m ()
10+
coverage compInp = do
11+
let nModules = length $ compInp ^. modules
12+
nTyDefs = length $ [td | m <- compInp ^. modules, td <- m ^. typeDefs]
13+
collect ("number of modules" :: String, nModules)
14+
collect ("number of type definitions" :: String, nTyDefs)

‎lambda-buffers-compiler/test/Test/LambdaBuffers/Compiler/Gen.hs‎

Lines changed: 0 additions & 144 deletions
This file was deleted.

0 commit comments

Comments
 (0)