File: | t/lib/Test/Class/TestGroup.pm |
Coverage: | 100.0% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | 2 2 2 | 0 0 0 | use strict; | ||||
2 | 2 2 2 | 0 0 0 | use warnings; | ||||
3 | |||||||
4 | package Test::Class::TestGroup; | ||||||
5 | |||||||
6 | 2 2 2 | 0 0 0 | no warnings 'redefine'; | ||||
7 | |||||||
8 | 2 2 2 | 0 0 0 | use parent 'Test::Class'; | ||||
9 | |||||||
10 | 2 2 2 | 0 0 0 | use Test::More; | ||||
11 | |||||||
12 | sub TestGroup : ATTR(CODE,RAWDATA) { | ||||||
13 | 12 | 0 | my ( $class, $symbol, $code_ref, $attr, $args ) = @_; | ||||
14 | |||||||
15 | # get the test description either from the args, or from the sub routine name; then reset the args to 1 (single test) | ||||||
16 | 12 4 | 0 0 | my $test_description = $args || *{$symbol}{NAME}; | ||||
17 | 12 | 0 | $args = 1; | ||||
18 | |||||||
19 | # wrap the old function in a subtest | ||||||
20 | 12 12 | 0 0 | my $old_func = \&{$symbol}; | ||||
21 | 12 | 0 | *{$symbol} = sub { | ||||
22 | 12 | 0 | my @params = @_; | ||||
23 | subtest $test_description => sub { | ||||||
24 | 12 | 0 | $old_func->( @params ); | ||||
25 | 12 | 0 | }; | ||||
26 | 12 | 0 | }; | ||||
27 | |||||||
28 | # tell Test::Class to run as a single test | ||||||
29 | 12 | 0 | Test::Class::Test( $class, $symbol, $code_ref, $attr, $args ); | ||||
30 | 2 2 2 | 0 0 0 | } | ||||
31 | |||||||
32 | 1; |