File Coverage

blib/lib/Test/Regression.pm
Criterion Covered Total %
statement 44 44 100.0
branch 13 14 92.8
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 66 67 98.5


line stmt bran cond sub pod time code
1             package Test::Regression;
2              
3 4     4   308879 use warnings;
  4         10  
  4         155  
4 4     4   25 use strict;
  4         6  
  4         136  
5 4     4   3198 use FileHandle;
  4         38421  
  4         27  
6 4     4   6987 use utf8;
  4         45  
  4         24  
7              
8             =head1 NAME
9              
10             Test::Regression - Test library that can be run in two modes; one to generate outputs and a second to compare against them
11              
12             =head1 VERSION
13              
14             Version 0.07
15              
16             =cut
17              
18             our $VERSION = '0.07';
19              
20             =head1 SYNOPSIS
21              
22             use Test::Regression;
23              
24             ok_regression(sub {return "hello world"}, "t/out/hello_world.txt");
25              
26             =head1 DESCRIPTION
27              
28             Using the various Test:: modules you can compare the output of a function
29             against what you expect. However if the output is complex and changes from
30             version to version, maintenance of the expected output could be costly. This
31             module allows one to use the test code to generate the expected output,
32             so that if the differences with model output are expected, one can easily
33             refresh the model output.
34              
35             =head1 EXPORT
36              
37             ok_regression
38              
39             =cut
40              
41 4     4   260 use Test::Builder::Module;
  4         8  
  4         410  
42 4     4   5001 use Test::Differences;
  4         79513  
  4         18192  
43 4     4   48 use base qw(Test::Builder::Module);
  4         10  
  4         2568  
44             our @EXPORT = qw(ok_regression);
45             my $CLASS = __PACKAGE__;
46              
47             =head1 FUNCTIONS
48              
49             =head2 ok_regression
50              
51             This function requires two arguments: a CODE ref and a file path. The CODE ref
52             is expected to return a SCALAR string which can be compared against previous
53             runs. If the TEST_REGRESSION_GEN is set to a true value, then the CODE ref is
54             run and the output written to the file. Otherwise the output of the
55             file is compared against the contents of the file.
56             There is a third optional argument which is the test name.
57              
58             =cut
59              
60             sub ok_regression {
61 20     20 1 8072 my $code_ref = shift;
62 20         33 my $file = shift;
63 20         35 my $test_name = shift;
64 20         30 my $output = eval { &$code_ref(); };
  20         56  
65 20         545 my $tb = $CLASS->builder;
66 20 100       201 if ($@) {
67 2         9 $tb->diag($@);
68 2         180 return $tb->ok( 0, $test_name );
69             }
70              
71             # generate the output files if required
72 18 100       57 if ( $ENV{TEST_REGRESSION_GEN} ) {
73 9         60 my $fh = FileHandle->new;
74 9 100       201 $fh->open(">$file")
75             || return $tb->ok( 0, "$test_name: cannot open $file" );
76 6         965 $fh->binmode;
77 6 100       78 if ( length $output ) {
78 4 100       23 $fh->print($output)
79             || return $tb->ok( 0, "actual write failed: $file" );
80             }
81 4         56 return $tb->ok( 1, $test_name );
82             }
83              
84             # compare the files
85 9 100       251 return $tb->ok( 0, "$test_name: cannot read $file" ) unless -r $file;
86 6         25 my $fh = FileHandle->new;
87 6 50       124 $fh->open("<$file") || return $tb->ok( 0, "$test_name: cannot open $file" );
88 6         304 $fh->binmode;
89 6         189 my $content = join '', (<$fh>);
90 6         31 eq_or_diff( $output, $content, $test_name );
91 6         63414 return $output eq $file;
92             }
93              
94             =head1 ENVIRONMENT VARIABLES
95              
96             =head2 TEST_REGRESSION_GEN
97              
98             If the TEST_REGRESSION_GEN environment file is unset or false in a perl sense,
99             then the named output files must exist and be readable and the test will run
100             normally comparing the outputs of the CODE refs against the contents of those
101             files. If the environment variable is true in a perl sense, then model output
102             files will be overwritten with the output of the CODE ref.
103              
104             =head1 AUTHOR
105              
106             Nicholas Bamber, C<< >>
107              
108             =head1 BUGS
109              
110             Please report any bugs or feature requests to C, or through
111             the web interface at L. I will be notified, and then you'll
112             automatically be notified of progress on your bug as I make changes.
113              
114             =head2 testing of STDERR
115              
116             The testing of stderr from this module is not as thorough as I would like.
117             L allows turning off of stderr checking but not matching
118             by regular expression. Handcrafted efforts currently fall foul of
119             L. Still it is I believe adequately tested in terms of coverage.
120              
121             =head1 SUPPORT
122              
123             You can find documentation for this module with the perldoc command.
124              
125             perldoc Test::Regression
126              
127              
128             You can also look for information at:
129              
130             =over 4
131              
132             =item * RT: CPAN's request tracker
133              
134             L
135              
136             =item * AnnoCPAN: Annotated CPAN documentation
137              
138             L
139              
140             =item * CPAN Ratings
141              
142             L
143              
144             =item * Search CPAN
145              
146             L
147              
148             =back
149              
150              
151             =head1 ACKNOWLEDGEMENTS
152              
153             =over
154              
155             =item Some documentation improvements have been suggested by toolic (http://perlmonks.org/?node_id=622051).
156              
157             =item Thanks to Filip GraliƄski for pointing out I need to test against output of zero length and providing a patch.
158              
159             =item Thanks to Christian Walde for pestering me about newline Windows
160             compatibility issues and for providing a patch.
161              
162             =back
163              
164             =head1 COPYRIGHT & LICENSE
165              
166             Copyright 2009-10 Nicholas Bamber.
167              
168             This program is free software; you can redistribute it and/or modify it
169             under the terms of either: the GNU General Public License as published
170             by the Free Software Foundation; or the Artistic License.
171              
172             See http://dev.perl.org/licenses/ for more information.
173              
174              
175             =cut
176              
177             1; # End of Test::Regression