113 lines
3.2 KiB
Haskell
113 lines
3.2 KiB
Haskell
module Main where
|
|
|
|
import Eval
|
|
import Lexer
|
|
import Parser
|
|
import Research
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
import Test.Tasty.QuickCheck
|
|
import Text.Megaparsec (runParser)
|
|
|
|
main :: IO ()
|
|
main = defaultMain tests
|
|
|
|
tests :: TestTree
|
|
tests = testGroup "Sapling Tests"
|
|
[ lexerTests
|
|
, parserTests
|
|
, integrationTests
|
|
, evaluationTests
|
|
, propertyTests
|
|
]
|
|
|
|
lexerTests :: TestTree
|
|
lexerTests = testGroup "Lexer Tests"
|
|
[ testCase "Lex simple identifiers" $ do
|
|
let input = "x a b = a"
|
|
let expected = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
|
|
runParser saplingLexer "" input @?= expected
|
|
|
|
, testCase "Lex Tree Calculus terms" $ do
|
|
let input = "t t t"
|
|
let expected = Right [LKeywordT, LKeywordT, LKeywordT]
|
|
runParser saplingLexer "" input @?= expected
|
|
|
|
, testCase "Handle invalid input" $ do
|
|
let input = "x = "
|
|
case runParser saplingLexer "" input of
|
|
Left _ -> return ()
|
|
Right _ -> assertFailure "Expected failure on invalid input"
|
|
]
|
|
|
|
parserTests :: TestTree
|
|
parserTests = testGroup "Parser Tests"
|
|
[ testCase "Parse function definitions" $ do
|
|
let input = "x a b = a"
|
|
let expected = SFunc "x" ["a", "b"] (SApp (SVar "a") [])
|
|
parseSapling input @?= expected
|
|
|
|
, testCase "Parse nested Tree Calculus terms" $ do
|
|
let input = "t (t t) t"
|
|
let expected = TFork (TStem TLeaf) TLeaf
|
|
parseSapling input @?= expected
|
|
|
|
, testCase "Parse sequential Tree Calculus terms" $ do
|
|
let input = "t t t"
|
|
let expected = TFork TLeaf TLeaf
|
|
parseSapling input @?= expected
|
|
]
|
|
|
|
integrationTests :: TestTree
|
|
integrationTests = testGroup "Integration Tests"
|
|
[ testCase "Combine lexer and parser" $ do
|
|
let input = "x = t t t"
|
|
let expected = SFunc "x" [] (TFork TLeaf TLeaf)
|
|
parseSapling input @?= expected
|
|
|
|
, testCase "Complex Tree Calculus expression" $ do
|
|
let input = "t (t t t) t"
|
|
let expected = TFork (TFork TLeaf TLeaf) TLeaf
|
|
parseSapling input @?= expected
|
|
]
|
|
|
|
evaluationTests :: TestTree
|
|
evaluationTests = testGroup "Evaluation Tests"
|
|
[ testCase "Evaluate single Leaf" $ do
|
|
let input = "t"
|
|
let ast = parseSapling input
|
|
evalSapling ast @?= Leaf
|
|
|
|
, testCase "Evaluate single Stem" $ do
|
|
let input = "t t"
|
|
let ast = parseSapling input
|
|
evalSapling ast @?= Stem Leaf
|
|
|
|
, testCase "Evaluate single Fork" $ do
|
|
let input = "t t t"
|
|
let ast = parseSapling input
|
|
evalSapling ast @?= Fork Leaf Leaf
|
|
|
|
, testCase "Evaluate nested Fork and Stem" $ do
|
|
let input = "t (t t) t"
|
|
let ast = parseSapling input
|
|
evalSapling ast @?= Fork (Stem Leaf) Leaf
|
|
|
|
, testCase "Evaluate `not` function" $ do
|
|
let input = "t (t (t t) (t t t)) t)"
|
|
let ast = parseSapling input
|
|
evalSapling ast @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
|
|
]
|
|
|
|
propertyTests :: TestTree
|
|
propertyTests = testGroup "Property Tests"
|
|
[ testProperty "Lexing and parsing round-trip" $ \input ->
|
|
case runParser saplingLexer "" input of
|
|
Left _ -> property True -- Ignore invalid lexes
|
|
Right tokens -> case runParser parseExpression "" tokens of
|
|
Left _ -> property True -- Ignore invalid parses
|
|
Right ast -> parseSapling input === ast
|
|
]
|
|
|