antlr-haskell-0.1.0.1: test/g4/Main.hs

{-# LANGUAGE TemplateHaskell, FlexibleContexts, TypeFamilies #-}
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 Text.ANTLR.Grammar
--import Language.ANTLR4.Regex
import Text.ANTLR.Parser (AST(..))
import qualified Text.ANTLR.LR as LR
import qualified Text.ANTLR.Lex.Tokenizer as T

import qualified Language.ANTLR4.G4 as P -- Parser

import qualified Optional as Opt
import qualified OptionalParser as Opt

import qualified EmptyP as E
import qualified Empty  as E

test_optional =
  Opt.glrParse Opt.isWS "a"
  @?=
  (LR.ResultAccept $ AST Opt.NT_r [NT Opt.NT_a] [AST Opt.NT_a [T Opt.T_1] [Leaf (Token Opt.T_1 Opt.V_1 1)]])

test_optional2 =
  case Opt.glrParse Opt.isWS "a a e b c d" of
    LR.ResultAccept ast -> Opt.ast2r ast @?= "accept"
    err                 -> error $ show err

test_optional3 =
  case Opt.glrParse Opt.isWS "a e b b b c c d" of
    LR.ResultAccept ast -> Opt.ast2r ast @?= "accept"
    err                 -> error $ show err

test_optional4 =
  case Opt.glrParse Opt.isWS "a" of
    LR.ResultAccept ast -> Opt.ast2r ast @?= "reject"
    err                 -> error $ show err

test_e v =
  case v of
    LR.ResultAccept ast -> E.ast2emp ast @?= ()
    err                 -> error $ show err
test_e_fail v =
  case v of
    LR.ResultAccept ast -> assertFailure $ show ast
    err                 -> () @?= ()
  
test_empty = test_e (E.slrParse (E.tokenize "a"))
test_empty2 = test_e (E.slrParse (E.tokenize "f"))
test_empty3 = test_e (E.slrParse (E.tokenize "ac"))
test_empty4 = test_e (E.slrParse (E.tokenize "fd"))
test_empty5 = test_e_fail (E.slrParse (E.tokenize "fc"))
test_empty6 = test_e_fail (E.slrParse (E.tokenize "ad"))

main :: IO ()
main = defaultMainWithOpts
  [ testCase "test_optional" test_optional
  , testCase "test_optional2" test_optional2
  , testCase "test_optional3" test_optional3
  , testCase "test_optional4" test_optional4
  , testCase "test_empty"     test_empty
  , testCase "test_empty2"    test_empty2
  , testCase "test_empty3"    test_empty3
  , testCase "test_empty4"    test_empty4
  , testCase "test_empty5"    test_empty5
  , testCase "test_empty6"    test_empty6
  ] mempty