| Subject: | TAP::Parser should be *easier* to subclass [PATCH] |
I've been trying to sub-class TAP::Parser to replace the
TAP::Parser::Source::Perl module with a custom one, and am finding I'd
have to re-implement a *lot* of code to do it.
I came to the conclusion that it would be easier to patch TAP::Parser to
make this behaviour *easily* achievable than have to maintain a custom
version of TAP::Parser.
See the attached patch, which makes it possible to easily override the
source, perl source, iterator, and grammar classes used. The tests are
not complete as I can't spend any more time on this currently.
To make it even easier to subclass, I would recommend introducing a
common base class for *all* TAP:: modules in the distro, eg: TAP::Base.
The reason? Because there are currently a hundred different customized
'new' methods:
~/dev/Test-Harness-3.10 $ grep -rn 'sub new' .
./examples/bin/tprove_gtk:103:sub new {
./examples/bin/tprove_gtk:383:sub new {
./examples/harness-hook/lib/Harness/Hook.pm:7:sub new {
./t/parse.t:810: sub new {
./t/proverun.t:57:sub new {
./t/lib/Test/Builder.pm:131:sub new {
./t/lib/IO/c55Capture.pm:34:sub new_handle {
./t/grammar.t:16:sub new {
./t/harness.t:35:sub new { bless {}, shift }
./t/harness.t:739: sub new { return bless {}, shift }
./t/console.t:39:sub new { bless {}, shift }
./t/prove.t:25:sub new {
./lib/App/Prove/State.pm:50:sub new {
./lib/App/Prove.pm:81:sub new {
./lib/TAP/Formatter/Color.pm:109:sub new {
./lib/TAP/Parser/Iterator/Stream.pm:61:sub new {
./lib/TAP/Parser/Iterator/Array.pm:63:sub new {
./lib/TAP/Parser/Iterator/Process.pm:98:sub new {
./lib/TAP/Parser/Multiplexer.pm:54:sub new {
./lib/TAP/Parser/Grammar.pm:46:sub new {
./lib/TAP/Parser/Result.pm:72:sub new {
./lib/TAP/Parser/Aggregator.pm:82:sub new {
./lib/TAP/Parser/Source.pm:45:sub new {
./lib/TAP/Parser/Iterator.pm:63:sub new {
./lib/TAP/Parser/YAMLish/Reader.pm:26:sub new {
./lib/TAP/Parser/YAMLish/Writer.pm:20:sub new {
./lib/TAP/Base.pm:54:sub new {
Why would this help? Because I came across an _initialize method, and
assumed it was being used everywhere. I was surprised (and annoyed)
when I found out it wasn't. It's not consistent, which makes
subclassing more painful that it should be.
| Subject: | Test-Harness-3.10-inheritance.patch |
diff -ruN Test-Harness-3.10.orig/lib/TAP/Parser/Source.pm Test-Harness-3.10/lib/TAP/Parser/Source.pm
--- Test-Harness-3.10.orig/lib/TAP/Parser/Source.pm 2008-02-10 17:18:44.000000000 +0000
+++ Test-Harness-3.10/lib/TAP/Parser/Source.pm 2008-06-03 10:28:02.000000000 +0100
@@ -44,9 +44,15 @@
sub new {
my $class = shift;
+ my $self = bless { switches => [] }, $class;
+ $self->_initialize( @_ );
+ return $self;
+}
+
+sub _initialize {
+ my $self = shift;
_autoflush( \*STDOUT );
_autoflush( \*STDERR );
- bless { switches => [] }, $class;
}
##############################################################################
diff -ruN Test-Harness-3.10.orig/lib/TAP/Parser.pm Test-Harness-3.10/lib/TAP/Parser.pm
--- Test-Harness-3.10.orig/lib/TAP/Parser.pm 2008-02-18 23:24:37.000000000 +0000
+++ Test-Harness-3.10/lib/TAP/Parser.pm 2008-06-03 10:37:18.000000000 +0100
@@ -270,6 +270,12 @@
}
}
+# This should make overriding behaviour of the Parser in subclasses easier:
+sub _source_class { 'TAP::Parser::Source' }
+sub _perl_source_class { 'TAP::Parser::Source::Perl' }
+sub _iterator_class { 'TAP::Parser::Iterator' }
+sub _grammar_class { 'TAP::Parser::Grammar' }
+
{
# of the following, anything beginning with an underscore is strictly
@@ -336,21 +342,20 @@
}
if ($tap) {
- $stream = TAP::Parser::Iterator->new( [ split "\n" => $tap ] );
+ $stream = $self->_iterator_class->new( [ split "\n" => $tap ] );
}
elsif ($exec) {
- my $source = TAP::Parser::Source->new;
+ my $source = $self->_source_class->new;
$source->source( [ @$exec, @test_args ] );
$source->merge($merge); # XXX should just be arguments?
$stream = $source->get_stream;
}
elsif ($source) {
if ( my $ref = ref $source ) {
- $stream = TAP::Parser::Iterator->new($source);
+ $stream = $self->_iterator_class->new($source);
}
elsif ( -e $source ) {
-
- my $perl = TAP::Parser::Source::Perl->new;
+ my $perl = $self->_perl_source_class->new;
$perl->switches($switches)
if $switches;
@@ -375,7 +380,7 @@
}
$self->_stream($stream);
- my $grammar = TAP::Parser::Grammar->new($stream);
+ my $grammar = $self->_grammar_class->new($stream);
$grammar->set_version( $self->version );
$self->_grammar($grammar);
$self->_spool($spool);
@@ -386,6 +391,7 @@
}
}
+
=head1 INDIVIDUAL RESULTS
If you've read this far in the docs, you've seen this:
diff -ruN Test-Harness-3.10.orig/t/parser-inherit.t Test-Harness-3.10/t/parser-inherit.t
--- Test-Harness-3.10.orig/t/parser-inherit.t 1970-01-01 01:00:00.000000000 +0100
+++ Test-Harness-3.10/t/parser-inherit.t 2008-06-03 10:49:38.000000000 +0100
@@ -0,0 +1,99 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ if ( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ( '../lib', 'lib' );
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+
+use Test::More tests => 7;
+use File::Spec;
+use TAP::Parser;
+
+use vars '%INIT';
+
+BEGIN {
+ package TAP::Parser::Test;
+ use vars '@ISA';
+ @ISA = 'TAP::Parser';
+ sub _source_class { 'MySource' }
+ sub _perl_source_class { 'MyPerlSource' }
+ sub _iterator_class { 'MyIterator' }
+ sub _initialize {
+ my $self = shift;
+ $self->SUPER::_initialize(@_);
+ $main::INIT{ref($self)}++;
+ $self->{initialized} = 1;
+ return $self;
+ }
+
+ package MySource;
+ use vars '@ISA';
+ @ISA = 'TAP::Parser::Source';
+ sub _initialize {
+ my $self = shift;
+ $self->SUPER::_initialize(@_);
+ $main::INIT{ref($self)}++;
+ $self->{initialized} = 1;
+ }
+ sub source {
+ my $self = shift;
+ return $self->SUPER::source(@_);
+ }
+ sub get_stream {
+ my $self = shift;
+ my $stream = $self->SUPER::get_stream(@_);
+ # re-bless it:
+ bless $stream, 'MyIterator';
+ }
+
+ package MyPerlSource;
+ use vars '@ISA';
+ @ISA = 'TAP::Parser::Source::Perl';
+ sub _initialize {
+ my $self = shift;
+ $self->SUPER::_initialize(@_);
+ $main::INIT{ref($self)}++;
+ $self->{initialized} = 1;
+ }
+ sub source {
+ my $self = shift;
+ return $self->SUPER::source(@_);
+ }
+
+ package MyIterator;
+ use vars '@ISA';
+ @ISA = 'TAP::Parser::Iterator';
+ sub _initialize {
+ my $self = shift;
+ $self->SUPER::_initialize(@_);
+ $main::INIT{ref($self)}++;
+ $self->{initialized} = 1;
+ }
+}
+
+my $test = File::Spec->catfile( ( $ENV{PERL_CORE} ? 'lib' : 't' ), 'source_tests', 'source' );
+
+my $p = TAP::Parser::Test->new( { source => $test } );
+ok( $p->{initialized}, 'initialized custom parser' );
+is( $p->_source_class, 'MySource', 'override source class' );
+is( $p->_perl_source_class, 'MyPerlSource', 'override perl source class' );
+
+is( $INIT{'TAP::Parser::Test'}, 1, 'initialized TAP::Parser subclass' );
+is( $INIT{MyPerlSource}, 1, 'initialized TAP::Parser::Source::Perl subclass' );
+
+TODO: {
+ local $TODO = 'not yet tested';
+ is( $INIT{MySource}, 1, 'initialized TAP::Parser::Source subclass' );
+ is( $INIT{MyIterator}, 1, 'initialized TAP::Parser::Iterator subclass' );
+}
+
+
+#use Data::Dumper;
+#print Dumper( \%INIT );