91 lines
3.7 KiB
Haskell
91 lines
3.7 KiB
Haskell
module Main where
|
|
|
|
import qualified Bril as B
|
|
import Data.Aeson (eitherDecode, decode, toJSON, parseJSON, Result(..))
|
|
import Data.Aeson.Types (parse)
|
|
import Data.Text
|
|
import Data.Maybe
|
|
import Data.Function ((&))
|
|
|
|
import Test.HUnit
|
|
import qualified System.Exit as Exit
|
|
|
|
testTypes :: Test
|
|
testTypes = TestCase $ do
|
|
assertEqual "int type" (decode "\"int\"" :: Maybe B.Type) (Just B.Int)
|
|
assertEqual "bool type" (decode "\"bool\"" :: Maybe B.Type) (Just B.Bool)
|
|
|
|
testLiterals :: Test
|
|
testLiterals = TestCase $ do
|
|
assertEqual "true literal"
|
|
(parseLiteral B.Bool ("true"::Text)) (Success $ B.BoolValue True)
|
|
assertEqual "false literal"
|
|
(parseLiteral B.Bool ("false"::Text)) (Success $ B.BoolValue False)
|
|
assertEqual "wrong bool literal"
|
|
(parseLiteral B.Bool ("xxx"::Text)) (Error "invalid bool literal: xxx")
|
|
|
|
assertEqual "int literal"
|
|
(parseLiteral B.Int (1434 :: Int)) (Success $ B.IntValue 1434)
|
|
assertEqual "wrong int literal"
|
|
(parseLiteral B.Int (100000000000000000000 :: Integer))
|
|
(Error "Integer exceeds int64: 1.0e20")
|
|
assertEqual "wrong int literal"
|
|
(parseLiteral B.Int (123.5 :: Double)) (Error "Invalid integer literal: 123.5")
|
|
|
|
where
|
|
parseLiteral type_ x = (parse (B.parseValue type_) (toJSON x))
|
|
|
|
testInstrs :: Test
|
|
testInstrs = TestCase $ do
|
|
assertEqual "add instr"
|
|
(eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
|
|
(Right $ B.ValueInstr B.Add B.Int "x" ["a", "b"] [] [])
|
|
|
|
assertEqual "sub instr"
|
|
(decode "{\"op\": \"sub\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
|
|
(Just $ B.ValueInstr B.Sub B.Int "x" ["a", "b"] [] [])
|
|
|
|
assertEqual "wrong instr"
|
|
(eitherDecode "{\"op\": \"wrnog\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
|
|
(Left "Error in $: Invalid op: wrnog" :: Either String B.Instruction)
|
|
|
|
assertEqual "wrong arity"
|
|
(eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"b\"]}")
|
|
(Left "Error in $: wrong arity for add: got 1, 0" :: Either String B.Instruction)
|
|
|
|
assertEqual "wrong label arity"
|
|
(eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"], \"labels\": [\"a\"]}")
|
|
(Left "Error in $: wrong arity for add: got 2, 1" :: Either String B.Instruction)
|
|
|
|
assertEqual "parse effect call"
|
|
(eitherDecode "{\"op\": \"call\", \"args\": [\"a\", \"b\"], \"funcs\": [\"a\"]}")
|
|
(Right $ B.EffectInstr B.Call ["a", "b"] ["a"] [])
|
|
|
|
assertEqual "parse value call"
|
|
(eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": [\"a\"]}")
|
|
(Right $ B.ValueInstr B.Call B.Bool "z" ["a", "b"] ["a"] [])
|
|
|
|
assertEqual "parse invalid call"
|
|
(eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": []}")
|
|
(Left "Error in $: call op must have exactly one entry in \"funcs\"" :: Either String B.Instruction)
|
|
|
|
assertEqual "parse jmp"
|
|
(eitherDecode "{\"op\": \"jmp\", \"labels\": [\"a\"]}")
|
|
(Right $ B.EffectInstr B.Jmp [] [] ["a"])
|
|
|
|
assertEqual "parse br"
|
|
(eitherDecode "{\"op\": \"br\", \"labels\": [\"a\", \"b\"], \"args\": [\"z\"]}")
|
|
(Right $ B.EffectInstr B.Br ["z"] [] ["a", "b"])
|
|
|
|
tests :: Test
|
|
tests = TestList [
|
|
TestLabel "bril parser: type" testTypes,
|
|
TestLabel "bril parser: literal" testLiterals,
|
|
TestLabel "bril parser: instruction" testInstrs
|
|
]
|
|
|
|
main :: IO ()
|
|
main = do
|
|
result <- runTestTT tests
|
|
if failures result > 0 then Exit.exitFailure else Exit.exitSuccess
|