public
Last active

a subclass of Test::Class that adds a TestGroup attribute

  • Download Gist
Test::Class::TestGroup.pm
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
use strict;
use warnings;
package Test::Class::TestGroup;
 
no warnings 'redefine';
use parent 'Test::Class';
 
use Test::More;
use Data::Dumper;
 
 
sub TestGroup : ATTR(CODE,RAWDATA) {
my ($class, $symbol, $code_ref, $attr, $args) = @_;
 
# get the test description either from the args, or from the sub routine name; then reset the args to 1 (single test)
my $test_description = $args || *{$symbol}{NAME};
$args = 1;
 
# wrap the old function in a subtest
my $old_func = \&{$symbol};
*{$symbol} = sub {
my @params = @_;
subtest $test_description => sub {
$old_func->( @params );
};
};
 
# tell Test::Class to run as a single test
Test::Class::Test($class, $symbol, $code_ref, $attr, $args);
};
 
1;
Z::Test.pm
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
use strict;
use warnings;
 
package Z::Test;
use parent 'Test::Class::TestGroup';
use Test::More;
 
sub overrides_basic : TestGroup(basic overrides work) {
ok( 1, "works" ); ok( 1, "works" );
}
sub overrides_no_profile : TestGroup(overrides without profile work) {
ok( 2, "works" ); ok( 2, "works" );
}
__PACKAGE__->runtests;
1;
zz_output
1 2 3 4 5 6 7 8 9
1..2
ok 1 - works
ok 2 - works
1..2
ok 1 - basic overrides work
ok 1 - works
ok 2 - works
1..2
ok 2 - overrides without profile work

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.