[Brazosvalley-pm] testing in Perl

[James Smith]

On Jul 24, 2006, at 12:11 PM, Jeremy Fluhmann wrote:

> Does anyone regularly write tests for their code?  I’m finally  
> trying to implement this into my coding practices.
It's been a while now since I was regularly writing Perl, but I did  
put together a framework for myself that is viewable on CPAN:

http://search.cpan.org/src/JSMITH/Gestinanna-0.02/t/lib/My/Builder.pm

That's my personal sub-class of Module::Build.  It uses Pod::Tests  
and a host of other modules to do its magic.

./Build dependencies   (ACTION_dependencies)

This action updates the XML project file with the module dependencies  
based on `use` statements and the methods defined in a particular  
package.

./Build tests  (ACTION_tests)

This action builds all the t/ files that contain the tests.  Tests  
are pulled from each module.  The files are numbered based on the  
dependency graph developed from the data in the XML project file  
created by the above dependencies action.

Each module can also define a setup and cleanup action that gets run  
at the beginning and end of each test file that has that module as a  
dependency.

./Build cover  (ACTION_cover)

This action runs the tests with Devel::Cover to get test coverage  
statistics.

./Build report  (ACTION_report)

This creates a series of HTML pages detailing each module, its  
dependencies, and its methods along with test statistics for each  
method (total tests, passing tests, coverage, documentation).

./Build graph   (ACTION_graph)

This creates a report of which tests ran successfully.  The report is  
an SVG file with a  graphical representation of the modules, their  
dependencies, and their methods with colors denoting completion of  
successful tests.

The modules on the right of the graph depend on the modules on the  
left.  I tended to code so modules turned from red to green going  
from left to right.



What does a typical module look like that makes use of the above  
framework?

package Gestinanna::Util

# some stuff

=head2 path2regex

=begin testing

# path2regex

my %paths = (
     '/' => q{\/},
     '/this' => q{\/this},
     '/*' => q{\/([^\/\@\|\&]+)},
     '//*' => q{\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@\|\&]+)},
     '//*@*' => q{\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@\|\&]+)\@([^ 
\/\@\|\&]+)},
     '//*@name' => q{\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@\|\&]+) 
\@name},
     '//* & //name' => q{(?(?=\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@ 
\|\&]+))(?:\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*name))},
);

foreach my $path (sort keys %paths) {
     is(__PACKAGE__::path2regex($path), $paths{$path}, "path2regex 
($path)");
}

is(__PACKAGE__::path2regex('//*'), $paths{'//*'}, "Cached path2regex 
(//*)");

=end testing

=cut

sub path2regex ($) {
   # ...
}

=head2 path_cmp

( A subset of B == -1, A superset of B == 1, A equivalent to B == 0,  
no intersection or unknown == undef )

=begin testing

# path_cmp

my @paths = (
     [ qw(a a), 1 ],
     [ qw(/this /that), undef ],
     [ qw(/this /that), undef ],
     [ '', '', 1 ],
     [ qw(/this /*), -1 ],
     [ qw(/* /this),  1 ],
     [ q(//foo | //bar), q(//foo | //baz), 0 ],
     [ qw(//*@* //*@name),  1 ],
     [ qw(//*@* //*@name),  1 ],
     [ qw(//*@name //*@*), -1 ],
     [ qw(//foo //bar), undef ],
     [ qw(/foo/bar/baz //bar), undef ],
     [ qw(/foo/bag //bar), undef ],
     [ qw(//bar /foo/bag), undef ],
     [ '/this | /that', '', 1 ],
     [ '', '/this | /that', -1 ],
     [ '/this', '/this | /that', -1 ],
     [ '//bar//* & //foo//*', '/baz/foo/bar/fob', 1],
);

foreach my $path (@paths) {
     is(__PACKAGE__::path_cmp($path->[0], $path->[1]), $path->[2],  
"__PACKAGE__::path_cmp($$path[0], $$path[1])");
}

=end testing

=cut

sub path_cmp ($$) {
   # ...  with calls to path2regex
}

__END__

In the tests, __OBJECT__ (or __OBJECT__(foo) ) is an auto-created  
object of __PACKAGE__ (this allows me to rename a package without  
having to edit all the tests).  __METHOD__ is the current method  
being tested (indicated by the comment right after the =begin testing  
line).  The resulting t/test file:

use lib q{t/lib};
use My::Builder;
# Testing found 1 nodes
use Test::More;
use Module::Build;

BEGIN {
     eval {
         require Gestinanna::Util;
     };

     if($@) {
         plan skip_all => 'Unable to load Gestinanna::Util';
         exit 0;
     }
}

plan no_plan;

my $builder = My::Builder -> current;

my %objects;

# method: path2regex

$builder -> begin_tests('path2regex');


{
     undef $main::_STDOUT_;
     undef $main::_STDERR_;
#line 187

my %paths = (
     '/' => q{\/},
     '/this' => q{\/this},
     '/*' => q{\/([^\/\@\|\&]+)},
     '//*' => q{\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@\|\&]+)},
     '//*@*' => q{\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@\|\&]+)\@([^ 
\/\@\|\&]+)},
     '//*@name' => q{\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@\|\&]+) 
\@name},
     '//* & //name' => q{(?(?=\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*([^\/\@ 
\|\&]+))(?:\/+(?:([^\/\@\|\&]+)\/+)*(?:\/)*name))},
);

foreach my $path (sort keys %paths) {
     is(Gestinanna::Util::path2regex($path), $paths{$path},  
"path2regex($path)");
}

is(Gestinanna::Util::path2regex('//*'), $paths{'//*'}, "Cached  
path2regex(//*)");


     undef $main::_STDOUT_;
     undef $main::_STDERR_;
}


$builder -> end_tests('path2regex');

# method: path_cmp

$builder -> begin_tests('path_cmp');


{
     undef $main::_STDOUT_;
     undef $main::_STDERR_;
#line 277

my @paths = (
     [ qw(a a), 1 ],
     [ qw(/this /that), undef ],
     [ qw(/this /that), undef ],
     [ '', '', 1 ],
     [ qw(/this /*), -1 ],
     [ qw(/* /this),  1 ],
     [ q(//foo | //bar), q(//foo | //baz), 0 ],
     [ qw(//*@* //*@name),  1 ],
     [ qw(//*@* //*@name),  1 ],
     [ qw(//*@name //*@*), -1 ],
     [ qw(//foo //bar), undef ],
     [ qw(/foo/bar/baz //bar), undef ],
     [ qw(/foo/bag //bar), undef ],
     [ qw(//bar /foo/bag), undef ],
     [ '/this | /that', '', 1 ],
     [ '', '/this | /that', -1 ],
     [ '/this', '/this | /that', -1 ],
     [ '//bar//* & //foo//*', '/baz/foo/bar/fob', 1],
);

foreach my $path (@paths) {
     is(Gestinanna::Util::path_cmp($path->[0], $path->[1]), $path-> 
[2], "Gestinanna::Util::path_cmp($$path[0], $$path[1])");
}


     undef $main::_STDOUT_;
     undef $main::_STDERR_;
}


$builder -> end_tests('path_cmp');
# record test results for report
$builder -> record_test_details('Gestinanna::Util');
my $tester = Test::More -> builder;
if($tester -> current_test == 0) {
     $tester -> skip_all( 'No tests defined' );
}

__END__


This test framework allows me to start with the documentation and  
then proceed to testing.  I can put all of the tests together with  
the human description of what a method is supposed to do before I  
ever write a line of code.  I can pass the module off to someone else  
at any point and know they have all the tests that I would have had.   
The reporting features of the Module::Build subclass allow me to put  
together nice progress reports to illustrate progress.

I have the method dependencies within a module hand coded in the XML  
file that describes the module dependencies.  I could (and probably  
should) have then listed in a comment in the testing section.   
Something like:

=begin testing

# path_cmp
# depends on: path2regex

...

=end testing

That way, the information is all in one place and the XML file should  
never need editing.

-- Jim
-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/pkcs7-signature
Size: 2425 bytes
Desc: not available
Url : http://mail.pm.org/pipermail/brazosvalley-pm/attachments/20060724/27ac0757/attachment.bin