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 11     11   333496 use strict;
  11         28  
  11         460  
2 11     11   67 use warnings;
  11         20  
  11         1290  
3             package Test::Routine::Util 0.032;
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 11     11   80 use Scalar::Util qw(reftype);
  11         57  
  11         1029  
19              
20 11     11   6956 use Sub::Exporter::Util qw(curry_method);
  11         118796  
  11         85  
21 11     11   8983 use Test::Routine::Compositor;
  11         41  
  11         465  
22 11     11   5664 use Test::Routine::Runner ();
  11         118  
  11         883  
23              
24 11         170 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 11     11   113 };
  11         56  
31              
32             our $UPLEVEL = 0;
33              
34             sub _curry_tester {
35 22     22   3559 my ($class, $name, $arg) = @_;
36              
37 22 50       161 Carp::confess("the $name generator does not accept any arguments")
38             if keys %$arg;
39              
40             return sub {
41 22     22   23370 local $UPLEVEL = $UPLEVEL + 1;
42 22         187 $class->$name(@_);
43 22         148 };
44             }
45              
46             sub run_me {
47 13     13 0 49 my ($class, $desc, $arg) = @_;
48              
49 13 100 100     200 if (@_ == 2 and (reftype $desc // '') eq 'HASH') {
      100        
50 3         13 ($desc, $arg) = (undef, $desc);
51             }
52              
53 13         45 my $caller = caller($UPLEVEL);
54              
55 13         35 local $UPLEVEL = $UPLEVEL + 1;
56 13         68 $class->run_tests($desc, $caller, $arg);
57             }
58              
59 22     22   287 sub _runner_class { 'Test::Routine::Runner' }
60 22     22   191 sub _compositor_class { 'Test::Routine::Compositor' }
61              
62             sub run_tests {
63 22     22 0 75 my ($class, $desc, $inv, $arg) = @_;
64              
65 22         155 my @caller = caller($UPLEVEL);
66              
67 22   66     160 $desc = $desc
68             // sprintf 'tests from %s, line %s', $caller[1], $caller[2];
69              
70 22         125 my $builder = $class->_compositor_class->instance_builder($inv, $arg);
71              
72 22         122 my $self = $class->_runner_class->new({
73             description => $desc,
74             instance_from => $builder,
75             });
76              
77 22         33240 $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.032
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
110             released in the last two to three years. (That is, if the most recently
111             released version is v5.40, then this module should work on both v5.40 and
112             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
117             lower 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