t/FSM-parse_grammar.t - metacpan.org

#!perl

# $Id: FSM-parse_grammar.t,v 1.1 2011/04/16 20:20:44 Paulo Exp $

use strict;
use warnings;

use Test::More;

use_ok 'Parse::FSM';
require_ok 't/utils.pl';

my $fsm;
my $parser;

#------------------------------------------------------------------------------
# prolog and epilog
$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	main : 'NUM' ;
END
is $fsm->prolog, undef;
is $fsm->epilog, undef;

$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	{prolog}
	main : 'NUM' ;
END
is $fsm->prolog, "prolog";
is $fsm->epilog, undef;

$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	{prolog}
	main : 'NUM' ;
	{epilog}
END
is $fsm->prolog, "prolog";
is $fsm->epilog, "epilog";

$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	main : 'NUM' ;
	{epilog}
END
is $fsm->prolog, undef;
is $fsm->epilog, "epilog";

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};

END
like $@, qr/^Expected one of \("<start" NAME\) at EOF at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	.
END
like $@, qr/^Expected one of \("<start" NAME\) at "." at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main
END
like $@, qr/^Expected ":" at EOF at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main : term '
END
like $@, qr/^Cannot parse quoted string at "'\\n" at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main : term "
END
like $@, qr/^Cannot parse quoted string at "\\"\\n" at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main : term {
END
like $@, qr/^Cannot parse code block at "{\\n" at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main : term { { }
END
like $@, qr/^Cannot parse code block at "{ { }\\n" at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main : term {}
END
like $@, qr/^Expected ";" at EOF at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main : term {}
		 | factor {}
END
like $@, qr/^Expected ";" at EOF at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	_main : term ;
END
like $@, qr/^Expected one of \("<start" NAME\) at _ at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# rules : syntax error
$fsm = new_ok('Parse::FSM');
eval {$fsm->parse_grammar(<<'END')};
	main : term ;
	!
END
like $@, qr/^Expected EOF at "!" at t.FSM-parse_grammar.t/;

#------------------------------------------------------------------------------
# main : term '+' term ; 
# term : NUM ;
$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	main : term '+' term '' ; 
	term : 'NUM' ;
END
isa_ok $parser = $fsm->parser, 'Parse::FSM::Driver';

$parser->input(make_lexer(""));
eval {$parser->parse};
is $@, "Expected NUM at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2"));
eval {$parser->parse};
is $@, "Expected \"+\" at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2+"));
eval {$parser->parse};
is $@, "Expected NUM at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2+3"));
is_deeply $parser->parse, [[NUM => 2], ["+" => "+"], [NUM => 3]];
is $parser->get_token, undef;

#------------------------------------------------------------------------------
# main : term '+' term ; 
# term : NUM ;
$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	main : term '+' term ''	{ $item[0] + $item[2] }; 	# add
	term : 'NUM' 			{ $item[0][1] };			# value
END
isa_ok $parser = $fsm->parser, 'Parse::FSM::Driver';

$parser->input(make_lexer(""));
eval {$parser->parse};
is $@, "Expected NUM at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2"));
eval {$parser->parse};
is $@, "Expected \"+\" at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2+"));
eval {$parser->parse};
is $@, "Expected NUM at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2+3"));
is_deeply $parser->parse, 5;
is $parser->get_token, undef;

#------------------------------------------------------------------------------
#  main   : (number | name)+ <eof> ;
#  number : 'NUMBER' { $item[0][1] } ; # comment
#  name   : 'NAME'   { $item[0][1] } ; # comment
$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	main   : (number | name)+ <eof> { $item[0] } ;
	number : 'NUM' 					{ $item[0][1] } ; # comment
	name   : 'NAME'   				{ $item[0][1] } ; # comment
END
isa_ok $parser = $fsm->parser, 'Parse::FSM::Driver';

$parser->input(make_lexer(""));
eval {$parser->parse};
is $@, "Expected one of (NAME NUM) at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2"));
is_deeply $parser->parse, [2];
is $parser->get_token, undef;

$parser->input(make_lexer("2 4"));
is_deeply $parser->parse, [2, 4];
is $parser->get_token, undef;

$parser->input(make_lexer("2 a 4"));
is_deeply $parser->parse, [2, 'a', 4];
is $parser->get_token, undef;

$parser->input(make_lexer("2!"));
eval {$parser->parse};
is $@, "Expected EOF at \"!\"\n";
is_deeply $parser->get_token, ["!" => "!"];
is $parser->get_token, undef;

#------------------------------------------------------------------------------
# expr : <list: number '-' number> ;
$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	expr   : <list: number '-' number> <eof>
						{ 	my @ops = @{$item[0]};
							@ops or die "empty ops\n";
							my $ret = shift @ops;
							while (@ops) {
								shift(@ops) eq '-' or die "expected -\n";
								$ret -= shift @ops;
							}
							return $ret;
						} ;
	number : 'NUM' 		{ $item[0][1] } ;
END
isa_ok $parser = $fsm->parser, 'Parse::FSM::Driver';

$parser->input(make_lexer(""));
eval {$parser->parse};
is $@, "Expected NUM at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2!"));
eval {$parser->parse};
is $@, "Expected EOF at \"!\"\n";
is_deeply $parser->get_token, ["!" => "!"];
is $parser->get_token, undef;

$parser->input(make_lexer("2"));
is $parser->parse, 2;
is $parser->get_token, undef;

$parser->input(make_lexer("3-2"));
is $parser->parse, 1;
is $parser->get_token, undef;

$parser->input(make_lexer("10-2-2"));
is $parser->parse, 6;
is $parser->get_token, undef;

#------------------------------------------------------------------------------
# expr : <list: number ('+'|'-') number> ;
$fsm = new_ok('Parse::FSM');
$fsm->parse_grammar(<<'END');
	expr   : <list: number ('+'|'-') number> <eof>
						{ 	my @ops = @{$item[0]};
							@ops or die "empty ops\n";
							my $ret = shift @ops;
							while (@ops) {
								my $op = shift(@ops)->[0];
								if ($op eq '+') {
									$ret += shift @ops;
								}
								elsif ($op eq '-') {
									$ret -= shift @ops;
								}
								else {
									die "expected + or -\n";
								}
							}
							return $ret;
						} ;
	number : 'NUM' 		{ $item[0][1] } ;
END
isa_ok $parser = $fsm->parser, 'Parse::FSM::Driver';

$parser->input(make_lexer(""));
eval {$parser->parse};
is $@, "Expected NUM at EOF\n";
is $parser->get_token, undef;

$parser->input(make_lexer("2!"));
eval {$parser->parse};
is $@, "Expected EOF at \"!\"\n";
is_deeply $parser->get_token, ["!" => "!"];
is $parser->get_token, undef;

$parser->input(make_lexer("2"));
is $parser->parse, 2;
is $parser->get_token, undef;

$parser->input(make_lexer("3-2"));
is $parser->parse, 1;
is $parser->get_token, undef;

$parser->input(make_lexer("10-2-2"));
is $parser->parse, 6;
is $parser->get_token, undef;

$parser->input(make_lexer("10-2-2+4"));
is $parser->parse, 10;
is $parser->get_token, undef;

$parser->input(make_lexer("10-2-2+4+3"));
is $parser->parse, 13;
is $parser->get_token, undef;


#------------------------------------------------------------------------------
done_testing;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)