X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Farm%2Flibtest-harness-perl%2Flibtest-harness-perl-3.12%2Ft%2Fgrammar.t;fp=dev%2Farm%2Flibtest-harness-perl%2Flibtest-harness-perl-3.12%2Ft%2Fgrammar.t;h=258d2377a1c55f33a144bb775ff3f5c4c9724ffe;hp=0000000000000000000000000000000000000000;hb=f477fa73365d491991707e7ed9217b48d6994551;hpb=da95c414033799c3a62606f299c3c00b5c77ca11

diff --git a/dev/arm/libtest-harness-perl/libtest-harness-perl-3.12/t/grammar.t b/dev/arm/libtest-harness-perl/libtest-harness-perl-3.12/t/grammar.t
new file mode 100644
index 0000000..258d237
--- /dev/null
+++ b/dev/arm/libtest-harness-perl/libtest-harness-perl-3.12/t/grammar.t
@@ -0,0 +1,452 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib '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';
+}