| 1 | #! /usr/bin/perl -Tw |
|---|
| 2 | |
|---|
| 3 | use strict; |
|---|
| 4 | use warnings; |
|---|
| 5 | |
|---|
| 6 | package Test::Class::MethodInfo; |
|---|
| 7 | use Carp; |
|---|
| 8 | |
|---|
| 9 | our $VERSION = '0.02'; |
|---|
| 10 | |
|---|
| 11 | sub new { |
|---|
| 12 | my ( $class, %param ) = @_; |
|---|
| 13 | my $self = bless { |
|---|
| 14 | name => $param{ name }, |
|---|
| 15 | type => $param{ type } || 'test', |
|---|
| 16 | }, $class; |
|---|
| 17 | unless ( defined $param{num_tests} ) { |
|---|
| 18 | $param{ num_tests } = $self->is_type('test') ? 1 : 0; |
|---|
| 19 | }; |
|---|
| 20 | $self->num_tests( $param{num_tests} ); |
|---|
| 21 | return $self; |
|---|
| 22 | }; |
|---|
| 23 | |
|---|
| 24 | sub name { shift->{name} }; |
|---|
| 25 | |
|---|
| 26 | sub num_tests { |
|---|
| 27 | my ( $self, $n ) = @_; |
|---|
| 28 | if ( defined $n ) { |
|---|
| 29 | croak "$n not valid number of tests" |
|---|
| 30 | unless $self->is_num_tests($n); |
|---|
| 31 | $self->{ num_tests } = $n; |
|---|
| 32 | }; |
|---|
| 33 | return $self->{ num_tests }; |
|---|
| 34 | }; |
|---|
| 35 | |
|---|
| 36 | sub is_type { |
|---|
| 37 | my ( $self, $type ) = @_; |
|---|
| 38 | return $self->{ type } eq $type; |
|---|
| 39 | }; |
|---|
| 40 | |
|---|
| 41 | sub is_method_type { |
|---|
| 42 | my ( $self, $type ) = @_; |
|---|
| 43 | return $type =~ m/^(startup|setup|test|teardown|shutdown)$/s; |
|---|
| 44 | }; |
|---|
| 45 | |
|---|
| 46 | sub is_num_tests { |
|---|
| 47 | my ( $self, $num_tests ) = @_; |
|---|
| 48 | return $num_tests =~ m/^(no_plan)|(\+?\d+)$/s; |
|---|
| 49 | }; |
|---|
| 50 | |
|---|
| 51 | 1; |
|---|
| 52 | __END__ |
|---|
| 53 | |
|---|
| 54 | =head1 NAME |
|---|
| 55 | |
|---|
| 56 | Test::Class::MethodInfo - the info associated with a test method |
|---|
| 57 | |
|---|
| 58 | =head1 SYNOPSIS |
|---|
| 59 | |
|---|
| 60 | # Secret internal class |
|---|
| 61 | # not for public use |
|---|
| 62 | |
|---|
| 63 | =head1 DESCRIPTION |
|---|
| 64 | |
|---|
| 65 | Holds info related to particular test methods. Not part of the public API and likely to change or completely disappear. If you need to rely on any of this code let me know and we'll see if we can work something out. |
|---|
| 66 | |
|---|
| 67 | =head1 METHODS |
|---|
| 68 | |
|---|
| 69 | =over 4 |
|---|
| 70 | |
|---|
| 71 | =item B<new> |
|---|
| 72 | |
|---|
| 73 | =item B<is_method_type> |
|---|
| 74 | |
|---|
| 75 | =item B<is_num_tests> |
|---|
| 76 | |
|---|
| 77 | =item B<is_type> |
|---|
| 78 | |
|---|
| 79 | =item B<name> |
|---|
| 80 | |
|---|
| 81 | =item B<num_tests> |
|---|
| 82 | |
|---|
| 83 | =back |
|---|
| 84 | |
|---|
| 85 | =head1 BUGS |
|---|
| 86 | |
|---|
| 87 | None known at the time of writing. Apart from the fact this seems a bit gnarly so I'm likely to tidy it up at some point. |
|---|
| 88 | |
|---|
| 89 | If you find any please let me know by e-mail, or report the problem with L<http://rt.cpan.org/>. |
|---|
| 90 | |
|---|
| 91 | =head1 TO DO |
|---|
| 92 | |
|---|
| 93 | If you think this module should do something that it doesn't (or does something that it shouldn't) please let me know. |
|---|
| 94 | |
|---|
| 95 | You can see my current to do list at L<http://adrianh.tadalist.com/lists/public/15423>, with an RSS feed of changes at L<http://adrianh.tadalist.com/lists/feed_public/15423>. |
|---|
| 96 | |
|---|
| 97 | =head1 AUTHOR |
|---|
| 98 | |
|---|
| 99 | Adrian Howard <adrianh@quietstars.com> |
|---|
| 100 | |
|---|
| 101 | If you can spare the time, please drop me a line if you find this module useful. |
|---|
| 102 | |
|---|
| 103 | =head1 SEE ALSO |
|---|
| 104 | |
|---|
| 105 | =over 4 |
|---|
| 106 | |
|---|
| 107 | =item L<Test::Class> |
|---|
| 108 | |
|---|
| 109 | What you should be looking at rather than this internal stuff |
|---|
| 110 | |
|---|
| 111 | =back |
|---|
| 112 | |
|---|
| 113 | =head1 LICENCE |
|---|
| 114 | |
|---|
| 115 | Copyright 2006 Adrian Howard, All Rights Reserved. |
|---|
| 116 | |
|---|
| 117 | This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
|---|
| 118 | |
|---|
| 119 | =cut |
|---|
