| 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; | ||||||