#!/usr/bin/perl -w
use strict;
BEGIN {
unshift @INC, 't/lib';
}
use Test::More tests => 94;
use EmptyParser;
use TAP::Parser::Grammar;
use TAP::Parser::Iterator::Array;
my $GRAMMAR = 'TAP::Parser::Grammar';
# Array based stream that we can push items in to
package SS;
sub new {
my $class = shift;
return bless [], $class;
}
sub next {
my $self = shift;
return shift @$self;
}
sub put {
my $self = shift;
unshift @$self, @_;
}
sub handle_unicode { }
package main;
my $stream = SS->new;
my $parser = EmptyParser->new;
can_ok $GRAMMAR, 'new';
my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
isa_ok $grammar, $GRAMMAR, '... and the object it returns';
# Note: all methods are actually class methods. See the docs for the reason
# why. We'll still use the instance because that should be forward
# compatible.
my @V12 = sort qw(bailout comment plan simple_test test version);
my @V13 = sort ( @V12, 'pragma', 'yaml' );
can_ok $grammar, 'token_types';
ok my @types = sort( $grammar->token_types ),
'... and calling it should succeed (v12)';
is_deeply \@types, \@V12, '... and return the correct token types (v12)';
$grammar->set_version(13);
ok @types = sort( $grammar->token_types ),
'... and calling it should succeed (v13)';
is_deeply \@types, \@V13, '... and return the correct token types (v13)';
can_ok $grammar, 'syntax_for';
can_ok $grammar, 'handler_for';
my ( %syntax_for, %handler_for );
foreach my $type (@types) {
ok $syntax_for{$type} = $grammar->syntax_for($type),
'... and calling syntax_for() with a type name should succeed';
cmp_ok ref $syntax_for{$type}, 'eq', 'Regexp',
'... and it should return a regex';
ok $handler_for{$type} = $grammar->handler_for($type),
'... and calling handler_for() with a type name should succeed';
cmp_ok ref $handler_for{$type}, 'eq', 'CODE',
'... and it should return a code reference';
}
# Test the plan. Gotta have a plan.
my $plan = '1..1';
like $plan, $syntax_for{'plan'}, 'A basic plan should match its syntax';
my $method = $handler_for{'plan'};
$plan =~ $syntax_for{'plan'};
ok my $plan_token = $grammar->$method($plan),
'... and the handler should return a token';
my $expected = {
'explanation' => '',
'directive' => '',
'type' => 'plan',
'tests_planned' => 1,
'raw' => '1..1',
'todo_list' => [],
};
is_deeply $plan_token, $expected,
'... and it should contain the correct data';
can_ok $grammar, 'tokenize';
$stream->put($plan);
ok my $token = $grammar->tokenize,
'... and calling it with data should return a token';
is_deeply $token, $expected,
'... and the token should contain the correct data';
# a plan with a skip directive
$plan = '1..0 # SKIP why not?';
like $plan, $syntax_for{'plan'}, 'a basic plan should match its syntax';
$plan =~ $syntax_for{'plan'};
ok $plan_token = $grammar->$method($plan),
'... and the handler should return a token';
$expected = {
'explanation' => 'why not?',
'directive' => 'SKIP',
'type' => 'plan',
'tests_planned' => 0,
'raw' => '1..0 # SKIP why not?',
'todo_list' => [],
};
is_deeply $plan_token, $expected,
'... and it should contain the correct data';
$stream->put($plan);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
is_deeply $token, $expected,
'... and the token should contain the correct data';
# implied skip
$plan = '1..0';
like $plan, $syntax_for{'plan'},
'A plan with an implied "skip all" should match its syntax';
$plan =~ $syntax_for{'plan'};
ok $plan_token = $grammar->$method($plan),
'... and the handler should return a token';
$expected = {
'explanation' => '',
'directive' => 'SKIP',
'type' => 'plan',
'tests_planned' => 0,
'raw' => '1..0',
'todo_list' => [],
};
is_deeply $plan_token, $expected,
'... and it should contain the correct data';
$stream->put($plan);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
is_deeply $token, $expected,
'... and the token should contain the correct data';
# bad plan
$plan = '1..0 # TODO 3,4,5'; # old syntax. No longer supported
unlike $plan, $syntax_for{'plan'},
'Bad plans should not match the plan syntax';
# Bail out!
my $bailout = 'Bail out!';
like $bailout, $syntax_for{'bailout'},
'Bail out! should match a bailout syntax';
$stream->put($bailout);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'bailout' => '',
'type' => 'bailout',
'raw' => 'Bail out!'
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
$bailout = 'Bail out! some explanation';
like $bailout, $syntax_for{'bailout'},
'Bail out! should match a bailout syntax';
$stream->put($bailout);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'bailout' => 'some explanation',
'type' => 'bailout',
'raw' => 'Bail out! some explanation'
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
# test comment
my $comment = '# this is a comment';
like $comment, $syntax_for{'comment'},
'Comments should match the comment syntax';
$stream->put($comment);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'comment' => 'this is a comment',
'type' => 'comment',
'raw' => '# this is a comment'
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
# test tests :/
my $test = 'ok 1 this is a test';
like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
$stream->put($test);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'ok' => 'ok',
'explanation' => '',
'type' => 'test',
'directive' => '',
'description' => 'this is a test',
'test_num' => '1',
'raw' => 'ok 1 this is a test'
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
# TODO tests
$test = 'not ok 2 this is a test # TODO whee!';
like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
$stream->put($test);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'ok' => 'not ok',
'explanation' => 'whee!',
'type' => 'test',
'directive' => 'TODO',
'description' => 'this is a test',
'test_num' => '2',
'raw' => 'not ok 2 this is a test # TODO whee!'
};
is_deeply $token, $expected, '... and the TODO should be parsed';
# false TODO tests
# escaping that hash mark ('#') means this should *not* be a TODO test
$test = 'ok 22 this is a test \# TODO whee!';
like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
$stream->put($test);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'ok' => 'ok',
'explanation' => '',
'type' => 'test',
'directive' => '',
'description' => 'this is a test \# TODO whee!',
'test_num' => '22',
'raw' => 'ok 22 this is a test \# TODO whee!'
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
# pragmas
my $pragma = 'pragma +strict';
like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
$stream->put($pragma);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'type' => 'pragma',
'raw' => $pragma,
'pragmas' => ['+strict'],
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
$pragma = 'pragma +strict,-foo';
like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
$stream->put($pragma);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'type' => 'pragma',
'raw' => $pragma,
'pragmas' => [ '+strict', '-foo' ],
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
$pragma = 'pragma +strict , -foo ';
like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
$stream->put($pragma);
ok $token = $grammar->tokenize,
'... and calling it with data should return a token';
$expected = {
'type' => 'pragma',
'raw' => $pragma,
'pragmas' => [ '+strict', '-foo' ],
};
is_deeply $token, $expected,
'... and the token should contain the correct data';
# coverage tests
# set_version
{
my @die;
eval {
local $SIG{__DIE__} = sub { push @die, @_ };
$grammar->set_version('no_such_version');
};
unless ( is @die, 1, 'set_version with bad version' ) {
diag " >>> $_ <<<\n" for @die;
}
like pop @die, qr/^Unsupported syntax version: no_such_version at /,
'... and got expected message';
}
# tokenize
{
my $stream = SS->new;
my $parser = EmptyParser->new;
my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
my $plan = '';
$stream->put($plan);
my $result = $grammar->tokenize();
isa_ok $result, 'TAP::Parser::Result::Unknown';
}
# _make_plan_token
{
my $parser = EmptyParser->new;
my $grammar = $GRAMMAR->new( { parser => $parser } );
my $plan
= '1..1 # SKIP with explanation'; # trigger warning in _make_plan_token
my $method = $handler_for{'plan'};
$plan =~ $syntax_for{'plan'}; # perform regex to populate $1, $2
my @warn;
eval {
local $SIG{__WARN__} = sub { push @warn, @_ };
$grammar->$method($plan);
};
is @warn, 1, 'catch warning on inconsistent plan';
like pop @warn,
qr/^Specified SKIP directive in plan but more than 0 tests [(]1\.\.1 # SKIP with explanation[)]/,
'... and its what we expect';
}
# _make_yaml_token
{
my $stream = SS->new;
my $parser = EmptyParser->new;
my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
$grammar->set_version(13);
# now this is badly formed YAML that is missing the
# leader padding - this is done for coverage testing
# the $reader code sub in _make_yaml_token, that is
# passed as the yaml consumer to T::P::YAMLish::Reader.
# because it isnt valid yaml, the yaml document is
# not done, and the _peek in the YAMLish::Reader
# code doesnt find the terminating '...' pattern.
# but we dont care as this is coverage testing, so
# if thats what we have to do to exercise that code,
# so be it.
my $yaml = [ ' ... ', '- 2', ' --- ', ];
sub iter {
my $ar = shift;
return sub {
return shift @$ar;
};
}
my $iter = iter($yaml);
while ( my $line = $iter->() ) {
$stream->put($line);
}
# pad == ' ', marker == '--- '
# length $pad == 3
# strip == pad
my @die;
eval {
local $SIG{__DIE__} = sub { push @die, @_ };
$grammar->tokenize;
};
is @die, 1, 'checking badly formed yaml for coverage testing';
like pop @die, qr/^Missing '[.][.][.]' at end of YAMLish/,
'...and it died like we expect';
}
{
# coverage testing for TAP::Parser::Iterator::Array
my $source = [qw( a b c )];
my $aiter = TAP::Parser::Iterator::Array->new($source);
my $first = $aiter->next_raw;
is $first, 'a', 'access raw iterator';
is $aiter->exit, undef, '... and note we didnt exhaust the source';
}