Add initial encoding tests.
parent
a63f2688db
commit
7303a43f5b
parser-initial
|
@ -24,3 +24,18 @@ library
|
|||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
exposed-modules: Parser
|
||||
|
||||
test-suite parser-initial-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Driver.hs
|
||||
hs-source-dirs: test
|
||||
build-depends: base ^>=4.14.3.0,
|
||||
HUnit,
|
||||
hspec,
|
||||
megaparsec,
|
||||
parser-initial,
|
||||
tasty,
|
||||
tasty-discover,
|
||||
tasty-hspec,
|
||||
text
|
||||
other-modules: Test.ParserTest
|
||||
|
|
|
@ -3,7 +3,9 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Parser
|
||||
( eval
|
||||
( Expr(..)
|
||||
, Parser
|
||||
, eval
|
||||
, memConsExpr
|
||||
, mulPassExpr
|
||||
, naiveExpr
|
||||
|
@ -42,7 +44,7 @@ data Expr
|
|||
| ESub Expr Expr
|
||||
| EAnd Expr Expr
|
||||
| EOr Expr Expr
|
||||
deriving (Show)
|
||||
deriving (Eq, Show)
|
||||
|
||||
eval :: Expr -> Either Text Expr
|
||||
eval e@(EInt _) = pure e
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}
|
|
@ -0,0 +1,67 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Test.ParserTest
|
||||
( spec_parser,
|
||||
) where
|
||||
|
||||
import qualified Text.Megaparsec as M
|
||||
|
||||
import Data.Text (Text, pack)
|
||||
import Parser
|
||||
import Test.Hspec (Expectation, Spec, describe, it, shouldBe)
|
||||
|
||||
runParser :: Parser Expr -> Text -> IO (Either Text Expr)
|
||||
runParser m input = pure case M.parse (m <* M.eof) "ParserTest" input of
|
||||
Left e -> Left . pack $ M.errorBundlePretty e
|
||||
Right a -> eval a
|
||||
|
||||
runParsers :: Text -> IO [Either Text Expr]
|
||||
runParsers input =
|
||||
mapM (`runParser` input) [naiveExpr, mulPassExpr, memConsExpr]
|
||||
|
||||
allEqual :: forall a. Eq a => [a] -> Bool
|
||||
allEqual [] = True
|
||||
allEqual [x] = True
|
||||
allEqual [x, y] = x == y
|
||||
allEqual (x:y:xs) = x == y && allEqual (y : xs)
|
||||
|
||||
shouldParse :: Text -> Expr -> Expectation
|
||||
shouldParse input expected = do
|
||||
res@(x : _) <- runParsers input
|
||||
shouldBe x $ Right expected
|
||||
shouldBe True $ allEqual res
|
||||
|
||||
shouldNotParse :: Text -> Text -> Expectation
|
||||
shouldNotParse input expected = do
|
||||
res@(x : _) <- runParsers input
|
||||
shouldBe x $ Left expected
|
||||
|
||||
spec_parser :: Spec
|
||||
spec_parser = do
|
||||
describe "literals" do
|
||||
it "1" do
|
||||
shouldParse "1" (EInt 1)
|
||||
it "true" do
|
||||
shouldParse "true" (EBool True)
|
||||
it "false" do
|
||||
shouldParse "false" (EBool False)
|
||||
describe "addition/subtraction" do
|
||||
it "binary" do
|
||||
shouldParse "1 + 1" (EInt 2)
|
||||
it "left associative" do
|
||||
shouldParse "1 - 3 + 4" (EInt 2)
|
||||
it "precedence" do
|
||||
shouldParse "1 - (3 + 4)" (EInt (-6))
|
||||
describe "conjunction/disjunction" do
|
||||
it "binary" do
|
||||
shouldParse "true && false" (EBool False)
|
||||
shouldParse "true && true" (EBool True)
|
||||
shouldParse "true || true" (EBool True)
|
||||
shouldParse "true || false" (EBool True)
|
||||
shouldParse "false || false" (EBool False)
|
||||
describe "invalid types" do
|
||||
it "mismatch" do
|
||||
shouldNotParse "true && 1" "Expected two booleans."
|
||||
shouldNotParse "1 + true" "Expected two integers."
|
Loading…
Reference in New Issue