Skip Menu |
 

This queue is for tickets about the Test-Harness CPAN distribution.

Report information
The Basics
Id: 36397
Status: resolved
Priority: 0/
Queue: Test-Harness

People
Owner: andy [...] hexten.net
Requestors: spurkis [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 3.10
Fixed in: (no value)

Attachments


Subject: TAP::Parser should be *easier* to subclass [PATCH]
Download (untitled) / with headers
text/plain 2.1k
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 );
Resolved. Steve is now a committer :) Thanks Steve.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.