module Main where import System.IO.Unsafe (unsafePerformIO) import Data.Monoid import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit import Test.QuickCheck (Property, quickCheck, (==>)) import qualified Test.QuickCheck.Monadic as TQM import Language.ANTLR4 hiding (tokenize, Regex(..)) import qualified G4Parser as G4P import qualified G4 as G4 import Hello import HelloParser import Text.ANTLR.Parser (AST(..)) import qualified Text.ANTLR.LR as LR import Language.ANTLR4.Boot.Syntax (Regex(..)) --import Language.ANTLR4.Regex (parseRegex) import qualified Language.ANTLR4.G4 as P -- Parser import qualified G4Fast as Fast test_g4_basic_type_check = do let _ = G4.g4BasicGrammar 1 @?= 1 hello_g4_test_type_check = do let _ = helloGrammar 1 @?= 1 {- regex_test = do parseRegex "[ab]* 'a' 'b' 'b'" @?= Right (Concat [ Kleene $ CharSet "ab" , Literal "a" , Literal "b" , Literal "b" ]) -} _1 = G4.lookupToken "1" -- TODO: implement 'read' instance for TokenValue type so that I don't have to -- hardcode the name for literal terminals (e.g. '1' == T_0 below) test_g4 = G4P.slrParse (G4P.tokenize "1") @?= LR.ResultAccept (AST G4.NT_exp [T G4.T_0] [Leaf _1]) test_hello = slrParse (tokenize "hello Matt") @?= (LR.ResultAccept $ AST NT_r [T T_0, T T_WS, T T_ID] [ Leaf (Token T_0 V_0 1) , Leaf (Token T_WS (V_WS " ") 1) , Leaf (Token T_ID (V_ID "Matt") 4) ] ) test_hello_allstar = allstarParse (const False) ("hello Matt") @?= Right (AST NT_r [T T_0, T T_WS, T T_ID] [Leaf (Token T_0 V_0 5),Leaf (Token T_WS (V_WS " ") 1),Leaf (Token T_ID (V_ID "Matt") 4)]) --Right (AST NT_r [] []) testFastGLR = Fast.glrParseFast (const False) "3" @?= G4P.glrParse (const False) "3" main :: IO () main = defaultMainWithOpts [ testCase "g4_basic_compilation_type_check" test_g4_basic_type_check , testCase "hello_parse_type_check" hello_g4_test_type_check -- , testCase "regex_test" regex_test , testCase "test_g4" test_g4 , testCase "test_hello" test_hello , testCase "test_hello_allstar" test_hello_allstar , testCase "testFastGLR" testFastGLR ] mempty