antlr-haskell-0.1.0.0: test/allstar/AllStarTests.hs
{-# LANGUAGE TypeFamilies #-}
module AllStarTests where
import Test.HUnit
import Text.ANTLR.Allstar.ParserGenerator
import qualified Data.Set as DS
--------------------------------TESTING-----------------------------------------
instance Token Char where
type Label Char = Char
type Literal Char = Char
getLabel c = c
getLiteral c = c
instance Token (a, b) where
type Label (a, b) = a
type Literal (a, b) = b
getLabel (a, b) = a
getLiteral (a, b) = b
atnEnv = DS.fromList [ -- First path through the 'S' ATN
(Init 'S', GS EPS, Middle 'S' 0 0),
(Middle 'S' 0 0, GS (NT 'A'), Middle 'S' 0 1),
(Middle 'S' 0 1, GS (T 'c'), Middle 'S' 0 2),
(Middle 'S' 0 2, GS EPS, Final 'S'),
-- Second path through the 'S' ATN
(Init 'S', GS EPS, Middle 'S' 1 0),
(Middle 'S' 1 0, GS (NT 'A'), Middle 'S' 1 1),
(Middle 'S' 1 1, GS (T 'd'), Middle 'S' 1 2),
(Middle 'S' 1 2, GS EPS, Final 'S'),
-- First path through the 'A' ATN
(Init 'A', GS EPS, Middle 'A' 0 0),
(Middle 'A' 0 0, GS (T 'a'), Middle 'A' 0 1),
(Middle 'A' 0 1, GS (NT 'A'), Middle 'A' 0 2),
(Middle 'A' 0 2, GS EPS, Final 'A'),
-- Second path through the 'A' ATN
(Init 'A', GS EPS, Middle 'A' 1 0),
(Middle 'A' 1 0, GS (T 'b'), Middle 'A' 1 1),
(Middle 'A' 1 1, GS EPS, Final 'A')]
-- For now, I'm only checking whether the input was accepted--not checking the derivation.
-- Example from the manual trace of ALL(*)'s execution
parseTest1 = TestCase (assertEqual "for parse [a, b, c],"
(Right (Node 'S'
[Node 'A'
[Leaf 'a',
Node 'A'
[Leaf 'b']],
Leaf 'c']))
(parse ['a', 'b', 'c'] (NT 'S') atnEnv True))
-- Example #1 from the ALL(*) paper
parseTest2 = TestCase (assertEqual "for parse [b, c],"
(Right (Node 'S'
[Node 'A'
[Leaf 'b'],
Leaf 'c']))
(parse ['b', 'c'] (NT 'S') atnEnv True))
-- Example #2 from the ALL(*) paper
parseTest3 = TestCase (assertEqual "for parse [b, d],"
(Right (Node 'S'
[Node 'A'
[Leaf 'b'],
Leaf 'd']))
(parse ['b', 'd'] (NT 'S') atnEnv True))
-- Input that requires more recursive traversals of the A ATN
parseTest4 = TestCase (assertEqual "for parse [a a a b c],"
(Right (Node 'S'
[Node 'A'
[Leaf 'a',
Node 'A'
[Leaf 'a',
Node 'A'
[Leaf 'a',
Node 'A'
[Leaf 'b']]]],
Leaf 'c']))
(parse ['a', 'a', 'a', 'b', 'c'] (NT 'S') atnEnv True))
-- Make sure that the result of parsing an out-of-language string has a Left tag.
parseTest5 = TestCase (assertEqual "for parse [a b a c],"
True
(let parseResult = parse ['a', 'b', 'a', 'c'] (NT 'S') atnEnv True
isLeft pr = case pr of
Left _ -> True
_ -> False
in isLeft parseResult))
-- To do: Update these tests so that they use the new ATN state representation.
{-
conflictsTest = TestCase (assertEqual "for getConflictSetsPerLoc()"
([[(MIDDLE 5, 1, []), (MIDDLE 5, 2, []),(MIDDLE 5, 3, [])],
[(MIDDLE 5, 1, [MIDDLE 1]), (MIDDLE 5, 2, [MIDDLE 1])],
[(MIDDLE 7, 2, [MIDDLE 6, MIDDLE 1])]] :: [[ATNConfig Char]])
(getConflictSetsPerLoc (D [(MIDDLE 5, 1, []),
(MIDDLE 5, 2, []),
(MIDDLE 5, 3, []),
(MIDDLE 5, 1, [MIDDLE 1]),
(MIDDLE 5, 2, [MIDDLE 1]),
(MIDDLE 7, 2, [MIDDLE 6, MIDDLE 1])])))
prodsTest = TestCase (assertEqual "for getProdSetsPerState()"
([[(MIDDLE 5, 1, []),
(MIDDLE 5, 2, []),
(MIDDLE 5, 3, []),
(MIDDLE 5, 1, [MIDDLE 1]),
(MIDDLE 5, 2, [MIDDLE 1])],
[(MIDDLE 7, 2, [MIDDLE 6, MIDDLE 1])]] :: [[ATNConfig Char]])
(getProdSetsPerState (D [(MIDDLE 5, 1, []),
(MIDDLE 5, 2, []),
(MIDDLE 5, 3, []),
(MIDDLE 5, 1, [MIDDLE 1]),
(MIDDLE 5, 2, [MIDDLE 1]),
(MIDDLE 7, 2, [MIDDLE 6, MIDDLE 1])])))
-}
ambigATNEnv = DS.fromList [(Init 'S', GS EPS, Middle 'S' 0 0),
(Middle 'S' 0 0, GS (T 'a'), Middle 'S' 0 1),
(Middle 'S' 0 1, GS EPS, Final 'S'),
(Init 'S', GS EPS, Middle 'S' 1 0),
(Middle 'S' 1 0, GS (T 'a'), Middle 'S' 1 1),
(Middle 'S' 1 1, GS EPS, Final 'S'),
(Init 'S', GS EPS, Middle 'S' 2 0),
(Middle 'S' 2 0, GS (T 'a'), Middle 'S' 2 1),
(Middle 'S' 2 1, GS (T 'b'), Middle 'S' 2 2),
(Middle 'S' 2 2, GS EPS, Final 'S')]
ambigParseTest1 = TestCase (assertEqual "for parse [a],"
True
(let parseResult = parse ['a'] (NT 'S') ambigATNEnv True
isLeft pr = case pr of
Left _ -> True
_ -> False
in isLeft parseResult))
ambigParseTest2 = TestCase (assertEqual "for parse [a b],"
(Right (Node 'S'
[Leaf 'a',
Leaf 'b']))
(parse ['a', 'b'] (NT 'S') ambigATNEnv True))
tests = [TestLabel "parseTest1" parseTest1,
TestLabel "parseTest2" parseTest2,
TestLabel "parseTest3" parseTest3,
TestLabel "parseTest4" parseTest4,
TestLabel "parseTest5" parseTest5,
--TestLabel "conflictsTest" conflictsTest,
--TestLabel "prodsTest" prodsTest,
TestLabel "ambigParseTest1" ambigParseTest1,
TestLabel "ambigParseTest2" ambigParseTest2]
main = runTestTT (TestList tests)