File Coverage

blib/lib/Test/Routine/Util.pm
Criterion Covered Total %
statement 40 40 100.0
branch 5 6 83.3
condition 5 5 100.0
subroutine 13 13 100.0
pod 0 2 0.0
total 63 66 95.4


line stmt bran cond sub pod time code
1 10     21   142381 use strict;
  10         48  
  10         260  
2 10     10   47 use warnings;
  10         17  
  10         515  
3             package Test::Routine::Util;
4             # ABSTRACT: helpful exports for dealing with test routines
5             $Test::Routine::Util::VERSION = '0.029';
6             #pod =head1 OVERVIEW
7             #pod
8             #pod Test::Routine::Util is documented in L<the Test::Routine docs on running
9             #pod tests|Test::Routine/Running Tests>. Please consult those for more information.
10             #pod
11             #pod Both C<run_tests> and C<run_me> are simple wrappers around the process of
12             #pod composing given Test::Routine roles into a class and instance using
13             #pod L<Test::Routine::Compositor>, creating a L<Test::Routine::Runner> object and
14             #pod telling it to execute the tests on the test instance.
15             #pod
16             #pod =cut
17              
18 10     10   59 use Scalar::Util qw(reftype);
  10         17  
  10         593  
19              
20 10     10   3971 use Sub::Exporter::Util qw(curry_method);
  10         54748  
  10         48  
21 10     10   5283 use Test::Routine::Compositor;
  10         23  
  10         246  
22 10     10   3710 use Test::Routine::Runner ();
  10         34  
  10         580  
23              
24 10         125 use Sub::Exporter -setup => {
25             exports => [
26             run_tests => \'_curry_tester',
27             run_me => \'_curry_tester',
28             ],
29             groups => [ default => [ qw(run_me run_tests) ] ],
30 10     10   80 };
  10         20  
31              
32             our $UPLEVEL = 0;
33              
34             sub _curry_tester {
35 20     20   2216 my ($class, $name, $arg) = @_;
36              
37 20 50       62 Carp::confess("the $name generator does not accept any arguments")
38             if keys %$arg;
39              
40             return sub {
41 21     21   21474 local $UPLEVEL = $UPLEVEL + 1;
42 21         140 $class->$name(@_);
43 20         88 };
44             }
45              
46             sub run_me {
47 13     13 0 44 my ($class, $desc, $arg) = @_;
48              
49 13 100 100     112 if (@_ == 2 and (reftype $desc || '') eq 'HASH') {
      100        
50 3         9 ($desc, $arg) = (undef, $desc);
51             }
52              
53 13         37 my $caller = caller($UPLEVEL);
54              
55 13         30 local $UPLEVEL = $UPLEVEL + 1;
56 13         54 $class->run_tests($desc, $caller, $arg);
57             }
58              
59 21     21   878 sub _runner_class { 'Test::Routine::Runner' }
60 21     21   136 sub _compositor_class { 'Test::Routine::Compositor' }
61              
62             sub run_tests {
63 21     21 0 65 my ($class, $desc, $inv, $arg) = @_;
64              
65 21         143 my @caller = caller($UPLEVEL);
66              
67 21 100       111 $desc = defined($desc)
68             ? $desc
69             : sprintf 'tests from %s, line %s', $caller[1], $caller[2];
70              
71 21         82 my $builder = $class->_compositor_class->instance_builder($inv, $arg);
72              
73 21         93 my $self = $class->_runner_class->new({
74             description => $desc,
75             instance_from => $builder,
76             });
77              
78 21         21592 $self->run;
79             }
80              
81             1;
82              
83             __END__
84              
85             =pod
86              
87             =encoding UTF-8
88              
89             =head1 NAME
90              
91             Test::Routine::Util - helpful exports for dealing with test routines
92              
93             =head1 VERSION
94              
95             version 0.029
96              
97             =head1 OVERVIEW
98              
99             Test::Routine::Util is documented in L<the Test::Routine docs on running
100             tests|Test::Routine/Running Tests>. Please consult those for more information.
101              
102             Both C<run_tests> and C<run_me> are simple wrappers around the process of
103             composing given Test::Routine roles into a class and instance using
104             L<Test::Routine::Compositor>, creating a L<Test::Routine::Runner> object and
105             telling it to execute the tests on the test instance.
106              
107             =head1 PERL VERSION
108              
109             This module should work on any version of perl still receiving updates from
110             the Perl 5 Porters. This means it should work on any version of perl released
111             in the last two to three years. (That is, if the most recently released
112             version is v5.40, then this module should work on both v5.40 and v5.38.)
113              
114             Although it may work on older versions of perl, no guarantee is made that the
115             minimum required version will not be increased. The version may be increased
116             for any reason, and there is no promise that patches will be accepted to lower
117             the minimum required perl.
118              
119             =head1 AUTHOR
120              
121             Ricardo Signes <cpan@semiotic.systems>
122              
123             =head1 COPYRIGHT AND LICENSE
124              
125             This software is copyright (c) 2010 by Ricardo Signes.
126              
127             This is free software; you can redistribute it and/or modify it under
128             the same terms as the Perl 5 programming language system itself.
129              
130             =cut