Subject: | [Patch+Test] TAPx::Parser::Streamed has leftovers from previous (unrelated) invocations |
The test file in this patch demonstrates a case where
TAPx::Parser::Stream is called, and then stops processing after a
bailout, and afterwards a different parser is initialised and gets
some of its leftover tokens.
This caused a subtle bug during the conversion of Test::Run to use
TAPx::Parser.
The patch also corrects the problem, by converting two "static"
variables into object variables.
I've noticed other places where such static variables are used, and
they may cause similar problems due to their Singleton nature.
Regards,
Shlomi Fish
Subject: | TAPx-Parser-premature-bailout.diff |
Index: t/80-premature-bailout.t
===================================================================
--- t/80-premature-bailout.t (revision 0)
+++ t/80-premature-bailout.t (revision 7)
@@ -0,0 +1,111 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Test::More tests => 14;
+use TAPx::Parser;
+
+use TAPx::Parser::Iterator;
+use TAPx::Parser::Streamed;
+
+sub tap_to_lines
+{
+ my $string = shift;
+ my @lines = ($string =~ /.*\n/g);
+ return \@lines;
+}
+
+my $tap = <<'END_TAP';
+1..4
+ok 1 - input file opened
+... this is junk
+not ok first line of the input valid # todo some data
+# this is a comment
+ok 3 - read the rest of the file
+not ok 4 - this is a real failure
+Bail out! We ran out of foobar.
+not ok 5
+END_TAP
+
+my $parser = TAPx::Parser->new(
+ {
+ stream => TAPx::Parser::Iterator->new(tap_to_lines($tap)),
+ }
+);
+
+# results() is sane?
+
+# check the test plan
+my $result = $parser->next();
+# TEST
+ok $result->is_plan, 'We should have a plan';
+
+# a normal, passing test
+
+my $test = $parser->next();
+# TEST
+ok $test->is_test, '... and a test';
+
+# junk lines should be preserved
+
+my $unknown = $parser->next();
+# TEST
+ok $unknown->is_unknown, '... and an unknown line';
+
+# a failing test, which also happens to have a directive
+
+my $failed = $parser->next();
+# TEST
+ok $failed->is_test, '... and another test';
+
+# comments
+
+my $comment = $parser->next();
+# TEST
+ok $comment->is_comment, '... and a comment';
+
+# another normal, passing test
+
+$test = $parser->next();
+# TEST
+ok $test->is_test, '... and another test';
+
+# a failing test
+
+$failed = $parser->next();
+# TEST
+ok $failed->is_test, '... and yet another test';
+
+# ok 5 # skip we have no description
+# skipped test
+my $bailout = $parser->next();
+# TEST
+ok $bailout->is_bailout, 'And finally we should have a bailout';
+# TEST
+is $bailout->as_string, 'We ran out of foobar.',
+ '... and as_string() should return the explanation';
+# TEST
+is ($bailout->raw, 'Bail out! We ran out of foobar.',
+ '... and raw() should return the explanation');
+# TEST
+is ($bailout->explanation, 'We ran out of foobar.',
+ '... and it should have the correct explanation');
+
+my $more_tap = "1..1\nok 1 - input file opened\n";
+
+my $second_parser = TAPx::Parser->new(
+ {
+ stream => TAPx::Parser::Iterator->new([split(/\n/, $more_tap)]),
+ }
+);
+
+$result = $second_parser->next();
+# TEST
+ok $result->is_plan(), "Result is not the leftover line";
+
+$result = $second_parser->next();
+# TEST
+ok $result->is_test(), "Result is a test";
+# TEST
+ok $result->passed(), "The event has passed";
+
Property changes on: t/80-premature-bailout.t
___________________________________________________________________
Name: svn:executable
+
Index: MANIFEST
===================================================================
--- MANIFEST (revision 5)
+++ MANIFEST (revision 7)
@@ -1,37 +1,35 @@
+
+
+
+
+
# build info
Build.PL
Changes
-Makefile.PL
-MANIFEST
-META.yml # Will be created by "make dist"
-README
-TODO
-
-# parsers
-lib/TAPx/Parser.pm
-lib/TAPx/Parser/Streamed.pm
-
-# helpers
-lib/TAPx/Parser/Aggregator.pm
-lib/TAPx/Parser/Iterator.pm
-lib/TAPx/Parser/Source/Perl.pm
examples/README
+examples/t/10-stuff.t
examples/tprove
examples/tprove_color
-examples/t/10-stuff.t
-
# grammars
+# helpers
+lib/TAPx/Parser/Aggregator.pm
lib/TAPx/Parser/Grammar.pm
-
-# result types
-lib/TAPx/Parser/Results.pm
+lib/TAPx/Parser/Iterator.pm
+lib/TAPx/Parser.pm
+lib/TAPx/Parser/Results/Bailout.pm
lib/TAPx/Parser/Results/Comment.pm
lib/TAPx/Parser/Results/Plan.pm
+lib/TAPx/Parser/Results.pm
lib/TAPx/Parser/Results/Test.pm
lib/TAPx/Parser/Results/Unknown.pm
-lib/TAPx/Parser/Results/Bailout.pm
-
-# tests
+lib/TAPx/Parser/Source/Perl.pm
+lib/TAPx/Parser/Streamed.pm
+Makefile.PL
+MANIFEST
+META.yml # Will be created by "make dist"
+# parsers
+README
+# result types
t/00-load.t
t/10-lex.t
t/20-parse.t
@@ -40,5 +38,7 @@
t/50-streams.t
t/60-aggregator.t
t/70-callbacks.t
+# tests
+TODO
t/pod-coverage.t
t/pod.t
Index: lib/TAPx/Parser.pm
===================================================================
--- lib/TAPx/Parser.pm (revision 5)
+++ lib/TAPx/Parser.pm (revision 7)
@@ -32,6 +32,8 @@
plan
tests_planned
tests_run
+ _m_tokens
+ _current_chunk
>
)
{
Index: lib/TAPx/Parser/Streamed.pm
===================================================================
--- lib/TAPx/Parser/Streamed.pm (revision 5)
+++ lib/TAPx/Parser/Streamed.pm (revision 7)
@@ -33,6 +33,7 @@
$self->_stream($stream);
$self->_start_tap(undef);
$self->_end_tap(undef);
+ $self->_m_tokens([]);
return $self;
}
@@ -58,47 +59,43 @@
return @tokens;
}
-{
- my ( @tokens, $current_chunk );
-
- # all of this annoying current and next chunk stuff is to ensure that we
- # really do know if we're at the beginning or end of a stream.
- sub next {
- my $self = shift;
- if (@tokens) {
- return shift @tokens;
+# all of this annoying current and next chunk stuff is to ensure that we
+# really do know if we're at the beginning or end of a stream.
+sub next {
+ my $self = shift;
+ if (@{$self->_m_tokens}) {
+ return shift @{$self->_m_tokens};
+ }
+ if ($self->_current_chunk) {
+ if ( $self->_stream_started ) {
+ $self->_start_tap(0);
}
- if ($current_chunk) {
- if ( $self->_stream_started ) {
- $self->_start_tap(0);
- }
- else {
- $self->_start_tap(1);
- $self->_stream_started(1);
- }
+ else {
+ $self->_start_tap(1);
+ $self->_stream_started(1);
}
- my $next_chunk = $self->_stream->next;
- if (! $current_chunk && $next_chunk ) {
- $current_chunk = $next_chunk;
- return $self->next;
- }
- unless ( defined $next_chunk ) {
- $self->_end_tap(1);
- }
- if ( defined $current_chunk ) {
- my @current_tokens = map {
- my $result = TAPx::Parser::Results->new($_);
- $self->_validate($result);
- $result;
- } $self->_lex($current_chunk);
- my $token = shift @current_tokens;
- push @tokens => @current_tokens;
- $current_chunk = $next_chunk;
- return $token;
- }
- $self->_finish;
- return;
}
+ my $next_chunk = $self->_stream->next;
+ if (! $self->_current_chunk() && $next_chunk ) {
+ $self->_current_chunk($next_chunk);
+ return $self->next;
+ }
+ unless ( defined $next_chunk ) {
+ $self->_end_tap(1);
+ }
+ if ( defined $self->_current_chunk ) {
+ my @current_tokens = map {
+ my $result = TAPx::Parser::Results->new($_);
+ $self->_validate($result);
+ $result;
+ } $self->_lex($self->_current_chunk());
+ my $token = shift @current_tokens;
+ push @{$self->_m_tokens()} => @current_tokens;
+ $self->_current_chunk($next_chunk);
+ return $token;
+ }
+ $self->_finish;
+ return;
}
=head1 OVERRIDDEN METHODS