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") (Success $ B.BoolValue True) assertEqual "false literal" (parseLiteral B.Bool "false") (Success $ B.BoolValue False) assertEqual "wrong bool literal" (parseLiteral B.Bool "xxx") (Error "invalid bool literal: xxx") assertEqual "int literal" (parseLiteral B.Int "1434") (Success $ B.IntValue 1434) assertEqual "negative int literal" (parseLiteral B.Int "-143443") (Success $ B.IntValue (- 143443)) assertEqual "wrong int literal" (parseLiteral B.Int "123xz") (Error "invalid int literal: 123xz") assertEqual "wrong int literal" (parseLiteral B.Int "123.5") (Error "invalid int literal: 123.5") assertEqual "wrong int literal" (parseLiteral B.Int "123.5") (Error "invalid int literal: 123.5") where parseLiteral type_ x = (parse (B.parseValue type_) (toJSON (x::Text))) 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