view release on metacpan or  search on metacpan

t/01.basics.t  view on Meta::CPAN

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..32\n"; }
END {print "not ok 1\n" unless $loaded;}
use Parse::RecDescent;
$loaded = 1;
print "ok 1\n";

sub debug { $D || $D || 0 }

my $count = 2;
sub ok($;$)
{
	my $ok = ((@_==2) ? ($_[0] eq $_[1]) : $_[0]);
	print "\texp=[$_[1]]\n\tres=[$_[0]]\n" if debug && @_==2;
	print "not " unless $ok;
	print "ok $count\n";
	$count++;
	return $ok;
}

######################### End of black magic.

do { $RD_TRACE = 1; $RD_HINT = 1; } if debug > 1;

$data1    = '(the 1st   teeeeeest are easy easy easyeasy';
$expect1  = '[1st|teeeeeest|are|easy:easy:easy:easy]';

$data2    = '(the 2nd   test is';
$expect2  = '[2nd|test|is|]';

$data3    = 'the cat';
$expect3a = 'fluffy';
$expect3b = 'not fluffy';

$data4    = 'a dog';
$expect4  = 'rover';

$data5    = 'type a is int; type b is a; var x holds b; type c is d;';
$expect5  = 'typedef=>a, typedef=>b, defn=>x, baddef, baddef';

require './t/util.pl';

##################################################################

$parser_A = new Parse::RecDescent q
{
	test1:	"(" 'the' "$::first" /te+st/ is ('easy')(s?)
			{ "[$item[3]|$item[4]|$item[5]|" .
				join(':', @{$item[6]})   .
				']' }

	is:	'is' | 'are'

#================================================================#

	test2:	<matchrule:$arg{article}>
		<matchrule:$arg[3]>[$arg{sound}]

	the:	'the'
	a:	'a'

	cat:	<reject: $arg[0] ne 'meows'> 'cat'
			{ "fluffy" }
	   |    { "not fluffy" }

	dog:	'dog'
			{ "rover" }

#================================================================#

	test3:	 (defn | typedef | fail)(5..10)