File Coverage

blib/lib/Test/Routine/Util.pm
Criterion Covered Total %
statement 40 40 100.0
branch 3 4 75.0
condition 7 8 87.5
subroutine 13 13 100.0
pod 0 2 0.0
total 63 67 94.0


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