antlr-haskell-0.1.0.1: test/allstar/AllStarTests.hs
{-# LANGUAGE TypeFamilies #-}
module AllStarTests where
--import Test.HUnit
import Text.ANTLR.Allstar.ParserGenerator
import qualified Data.Set as DS
import Text.ANTLR.Parser (HasEOF(..))
import Text.ANTLR.Grammar (Ref(..))
import Test.Framework
import Test.Framework.Providers.HUnit
import Text.ANTLR.HUnit
import Text.ANTLR.Pretty
--------------------------------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 -}
instance (Show a, Show b) => Prettify (Either a b) where prettify = rshow
instance Ref Char where
type Sym Char = Char
getSymbol = id
instance HasEOF Char where
type StripEOF Char = Char
isEOF c = False
stripEOF c = Just c
dumbTokenizer [] = []
dumbTokenizer (t:ts) = [(t,ts)]
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 = ((@=?) --"for parse dumbTokenizer [a, b, c],"
(Right (Node 'S' [NT 'A', T 'c']
[Node 'A' [T 'a', NT 'A']
[Leaf 'a',
Node 'A' [T 'b']
[Leaf 'b']],
Leaf 'c']))
(parse dumbTokenizer ['a', 'b', 'c'] (NT 'S') atnEnv True))
-- Example #1 from the ALL(*) paper
parseTest2 = ((@=?) --"for parse dumbTokenizer [b, c],"
(Right (Node 'S' [NT 'A', T 'c']
[Node 'A' [T 'b']
[Leaf 'b'],
Leaf 'c']))
(parse dumbTokenizer ['b', 'c'] (NT 'S') atnEnv True))
-- Example #2 from the ALL(*) paper
parseTest3 = ((@=?) --"for parse dumbTokenizer [b, d],"
(Right (Node 'S' [NT 'A', T 'd']
[Node 'A' [T 'b']
[Leaf 'b'],
Leaf 'd']))
(parse dumbTokenizer ['b', 'd'] (NT 'S') atnEnv True))
-- Input that requires more recursive traversals of the A ATN
parseTest4 = ((@=?) --"for parse dumbTokenizer [a a a b c],"
(Right (Node 'S' [NT 'A', T 'c']
[Node 'A' [T 'a', NT 'A']
[Leaf 'a',
Node 'A' [T 'a', NT 'A']
[Leaf 'a',
Node 'A' [T 'a', NT 'A']
[Leaf 'a',
Node 'A' [T 'b']
[Leaf 'b']]]],
Leaf 'c']))
(parse dumbTokenizer ['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 = ((@=?) --"for parse dumbTokenizer [a b a c],"
True
(let parseResult = parse dumbTokenizer ['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 = ((@=?) --"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 = ((@=?) --"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 = ((@=?) --"for parse dumbTokenizer [a],"
True
(let parseResult = parse dumbTokenizer ['a'] (NT 'S') ambigATNEnv True
isLeft pr = case pr of
Left _ -> True
_ -> False
in isLeft parseResult))
ambigParseTest2 = ((@=?) --"for parse dumbTokenizer [a b],"
(Right (Node 'S' [T 'a', T 'b']
[Leaf 'a',
Leaf 'b']))
(parse dumbTokenizer ['a', 'b'] (NT 'S') ambigATNEnv True))
tests = [testCase "parseTest1" parseTest1,
testCase "parseTest2" parseTest2,
testCase "parseTest3" parseTest3,
testCase "parseTest4" parseTest4,
testCase "parseTest5" parseTest5,
--testCase "conflictsTest" conflictsTest,
--testCase "prodsTest" prodsTest,
testCase "ambigParseTest1" ambigParseTest1,
testCase "ambigParseTest2" ambigParseTest2]
--main = runTestTT (TestList tests)