http://qs1969.pair.com?node_id=280268

This script will help you write test suites by automatigically generating a complete test suite for a given Module (OO or export based). All you will need to do is add the appropriate tests to the supplied ok( some_func() ) stubs, deleting or adding tests as appropriate. It also has a handy renumber function that is written into the test script stub so when you add a new test in the middle of your tests you can just do:

script.t renum

And all your tests will get correctly renumbered. The plan will also be updated.

Update

Added chmod 0755 $0 on renum and write stubs.

#!/usr/bin/perl -w use strict; use Test; # use the required libraries ( you will need to edit this for your dev +el environment) use lib '/devel/www/cgi-bin/'; if ( $ARGV[0] and $ARGV[0] =~ m!help|\?! ) { open SELF, $0 or die "Can't open myself to read pod you will have +to RTFS!\n"; local $/; my $pod = <SELF>; close SELF; my ( $help ) = $pod =~ m!^(=head.*?=cut)!sm; print $help ? "$help\n" : "Sorry no help available, RTFS!\n"; exit 0; } # set debugging mode if desired my $debug = ( $ARGV[0] and $ARGV[0] eq 'debug' ) ? 1 : 0; # is this an auto renumber request my $renum = ( $ARGV[0] and $ARGV[0] eq 'renum' ) ? 1 : 0; # use a BEGIN block so we print our plan before MyModule is loaded BEGIN { plan tests => 1, todo => [] } =head2 NAME template.t This script will automatically write stub test files for you. A little + work from you to fill in the blanks and you have a test suite. It will + handle OO or Export based test stubbing =head2 SYNOPSIS You can call this script in four ways script.t script.t debug script.t renum script.t Some::Module [oo] When called with no command line are all the tests are run When called with the debug option all tests are run + extra reporting When called with the renum option all the ok() tests within script.t will be automatically sequentially numbered with a comment like ok(BLAH) #35 where 35 is the test number you will see when you run the tests. When called with any command line arg other than 'debug' or 'renum' then the script will assume that this is a module name and search @INC for that module. You will probably want to add a line like: use lib '/my/devel/module/base/dir/'; so that the script can find the module you want to stub testf for. Provided a matching module is found the script will write a stub test script called stub_[NAME].t into the current directory. By default this stub test file will be written to test all the @EXPORT and @EXPORT_OK functions. If it is an OO module that has no exports add a second command line arg (any true value will do) and it will read all the sub names and add stub tests for the lot, both oo and direct calls. The stub file should be renamed [NAME].t unless this already exists in which case you will need to do some cut and paste. All you then need to do is add some data to the ok() stub tests, delete or add more and you have a fully functional test suite. The stub module retains the renum functionality of template.t but loses the generate new stubs functionality. =head2 EXPORT Nothing, but it does write the stub_[NAME].t file =head2 BUGS Probably, perhaps they are features? =head2 AUTHOR INFORMATION Copyright 2002 Dr James Freeman E<lt>jfreeman@tassie.net.auE<gt> This package is free software and is provided "as is" without express or implied warranty in the hope that it may be found useful. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) =cut if ( $ARGV[0] and ! $debug ) { if ( $renum ) { run_renumber(); } else { run_add_test_stubs( @ARGV ); } exit; } =head1 Synopsis of Test syntax use strict; use Test; # use a BEGIN block so we print our plan before MyModule is loaded BEGIN { plan tests => 14, todo => [3,4] } # load your module... use MyModule; ok(0); # failure ok(1); # success ok(0); # ok, expected failure (see todo list, above) ok(1); # surprise success! ok(0,1); # failure: '0' ne '1' ok('broke','fixed'); # failure: 'broke' ne 'fixed' ok('fixed','fixed'); # success: 'fixed' eq 'fixed' ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/ ok(sub { 1+1 }, 2); # success: '2' eq '2' ok(sub { 1+1 }, 3); # failure: '2' ne '3' ok(0, int(rand(2)); # (just kidding :-) my @list = (0,0); ok @list, 3, "\@list=".join(',',@list); #extra diagnostics ok 'segmentation fault', '/(?i)success/'; #regex match skip($feature_is_missing, ...); #do platform specific test Note use the ok( blah, blah ) form rather than ok( blah == blah ) as w +hen a test fails the first form tells you what it got and what it expected. +The second form with either be 1 or 0 - not so informative. #leave this =cut #--------------------------------------------------------------------- +--------- # BEGIN module specific test code #--------------------------------------------------------------------- +--------- #<TEST CODE HERE> #--------------------------------------------------------------------- +--------- # END module specific test code #--------------------------------------------------------------------- +--------- #--------------------------------------------------------------------- +--------- # Wrap up and report in #--------------------------------------------------------------------- +--------- my $tests = $Test::ntest - 1; $tests ||= 1; # protect illegal div 0 error.... my $fail = @Test::FAILDETAIL; my $ok = $tests - $fail; print "\nRan $0 debug=$debug\nCompleted $tests tests $ok/$tests OK, fa +iled $fail/$tests\n"; printf "%3.1f%% of tests completed successfully, %3.1f%% failed\n" , $ +ok*100/$tests, $fail*100/$tests; if ( $debug and $fail ) { use Data::Dumper; print "\n",Dumper(@Test::FAILDETAIL); } sub run_renumber { rename $0, "$0.bak" or die "Rename $0 to $0.bak failed $!\n"; open I, "$0.bak" or die "Can't open self $0.bak $!\n"; open O, ">$0" or die "Can't write new file\n"; chmod 0755, $0; my $num = 0; my $file = ''; my $found_begin = 0; my $found_end = 0; while (<I>) { $found_end = 1 if m/# END/; $found_begin = 1 if m/# BEGIN/; if ( $found_begin and m/^\s*(ok\s*\(.*;)/ and ! $found_end ) { $num++; $file .= "$1 #$num\n"; } else { $file .= $_; } } $file =~ s/plan\s+tests\s*=>\s*\d+/plan tests => $num/; print O $file; close O; close I; print "Added test numbers 1..$num to $0 and fixed plan OK\n"; unlink "$0.bak" or warn "Can't unlink backup $0.bak $!\n"; } # find all the subs in a module sub find_all_subs { my ( $MODULE ) = @_; $MODULE =~ s!::!/!g; my @subs = (); for my $dir ( @INC ) { print "Checking $dir/$MODULE.pm\n"; next unless -e "$dir/$MODULE.pm"; print "Found $dir/$MODULE.pm\n"; open M, "$dir/$MODULE.pm" or die "Can't read $dir/$MODULE.pm $ +!\n"; local $/; my $module = <M>; close M; @subs = $module =~ m/^\s*sub\s+(\w+)/gm; last; } return @subs; } sub run_add_test_stubs { my ( $MODULE, $IS_OO ) = @_; no strict; eval "require($MODULE)"; die "Could not require $MODULE\n$@\n" if $@; my @exports; if ( $IS_OO ) { @exports = find_all_subs( $MODULE ); } else { eval { my @exports_ok = eval "\@${MODULE}::EXPORT_OK"; push @e +xports, @exports_ok }; eval { my @export = eval "\@${MODULE}::EXPORT"; push @exports, + @export }; } die "$MODULE has no \@EXPORT or \@EXPORT_OK functions\nIs it oo? If +so add oo as a command line arg\n\n\$ perl template Some::Module oo\n +\n\$ perl template --help\n\n" unless @exports; printf "Found %d functions to test!\n", scalar @exports; my $num_tests = 1; my $imports = $IS_OO ? ";\n\nmy \$obj;" : "qw(\n" . (join '', ma +p{ " $_\n" } @exports ) . ");\n"; my $comment = $IS_OO ? '# first use the $MODULE.pm module' : "# +first use the $MODULE.pm module and import all the \@EXPORT_OK functi +ons"; my $test_stubs = $IS_OO ? join "\n", map{ <<STUBS1; # tests for $_() #\$obj = $MODULE->new(); # oo tests #ok( \$obj->$_(undef), '' ); #ok( \$obj->$_(0), '' ); #ok( \$obj->$_(''), '' ); #ok( \$obj->$_('some','args'), '' ); # direct calls in case you want them.... #ok( ${MODULE}::$_(undef), '' ); #ok( ${MODULE}::$_(0), '' ); #ok( ${MODULE}::$_(''), '' ); #ok( ${MODULE}::$_('some','args'), '' ); STUBS1 }@exports : join "\n", map{ <<STUBS2; # tests for $_() #ok( $_(undef), '' ); #ok( $_(0), '' ); #ok( $_(''), '' ); #ok( $_('some','args'), '' ); STUBS2 }@exports; my $code=<<CODE; $comment use $MODULE $imports # first make sure the module loaded OK ok(1); # test 1 $test_stubs CODE my $replacement_pod =<<'CODE'; =head1 Usage You can call this script in three ways script.t script.t debug script.t renum When called with no command line are all the tests are run When called with the debug option all tests are run + extra reporting When called with any other command line arg, 'renum' for instance the +script will renumber all the tests within it and set the plan tests key to the cor +rect value. =head1 Synopsis of Test syntax use strict; use Test; # use a BEGIN block so we print our plan before MyModule is loaded BEGIN { plan tests => 14, todo => [3,4] } # load your module... use MyModule; ok(0); # failure ok(1); # success ok(0); # ok, expected failure (see todo list, above) ok(1); # surprise success! ok(0,1); # failure: '0' ne '1' ok('broke','fixed'); # failure: 'broke' ne 'fixed' ok('fixed','fixed'); # success: 'fixed' eq 'fixed' ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/ ok(sub { 1+1 }, 2); # success: '2' eq '2' ok(sub { 1+1 }, 3); # failure: '2' ne '3' ok(0, int(rand(2)); # (just kidding :-) my @list = (0,0); ok @list, 3, "\@list=".join(',',@list); #extra diagnostics ok 'segmentation fault', '/(?i)success/'; #regex match skip($feature_is_missing, ...); #do platform specific test Note use the ok( blah, blah ) form rather than ok( blah == blah ) as w +hen a test fails the first form tells you waht it got and what it expected. +The second form with either be 1 or 0 - not so informative. =cut if ( $ARGV[0] and $ARGV[0] ne 'debug' ) { run_renumber(); exit; } CODE my @bits = split '::', $MODULE; my $outfile = 'stub_' . lc($bits[-1]) . '.t'; open I, $0 or die "Can't open self $0 $!\n"; open O, ">$outfile" or die "Can't write $outfile\n"; local $/; my $data = <I>; $data =~ s/#<TEST CODE HERE>/$code/; # add th +e stubs $data =~ s/=head2.*#leave this\n=cut/$replacement_pod/s; # fix po +d $data =~ s/sub run_add_test_stubs.*//s; # delete + this section $data =~ s/plan\s+tests\s*=>\s*\d+/plan tests => $num_tests/; # fi +x test count print O $data; close O; close I; print "Wrote test stub file $outfile for $MODULE OK\n"; } 1;

Replies are listed 'Best First'.
Re: Autogenerate Test Scripts
by hsmyers (Canon) on Aug 02, 2003 at 23:14 UTC
    This is a plot, right!!? You're just trying to make it so easy to uses tests that we no longer have any excuses left at all. For shame! How can we remain slovenly and slip-shod if you continue on this path? You will doom us all to decency!!!

    --hsm

    "Never try to teach a pig to sing...it wastes your time and it annoys the pig."