Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Autogenerate test scripts for your perl modules..

by reyjrar (Hermit)
on Aug 29, 2002 at 20:30 UTC ( [id://193901]=CUFP: print w/replies, xml ) Need Help??

More than likely, something like this exists somewhere else. I just didn't feel like looking for it today. Basically this script when run in a module directory will generate the barebones test scripts for any modules found in cwd() . 'lib'; Its just a quick hack but it does do something kinda cool. If leaves a section for you to enter in your own module specific tests, and then if for some reason (you add a new module to your package, add/remove subs from a current pacakge), it will grab your tests, replace everything it originally put in there and rewrite it, and append your custom tests so long as they come after the # ===> <=== # line.

Lemme know what you think..

-brad..

#!/usr/bin/perl # # Generate the base test files for the modules # in a given base directory $|++; use strict; use Getopt::Std; use File::Find; my %OPTS = (); getopts('vOht:d:', \%OPTS); &help if $OPTS{h}; my $LIB_DIR = $OPTS{d} || 'lib'; $LIB_DIR =~ s/\/$//; my $TEST_DIR = $OPTS{t} || 't'; $TEST_DIR =~ s/\/$//; my $OVERWRITE_OK = $OPTS{O}; my %MODULES = (); die "Directory: $LIB_DIR isn't a directory!\n" unless -d $LIB_DIR; # # populate the %MODULES hash find(\&build_hash, $LIB_DIR); my $MODULES = scalar keys %MODULES; die "No modules found in $LIB_DIR !\n" unless $MODULES > 0; logthis( "Found $MODULES Modules to write tests for.\n" ); # # make sure our $TEST_DIR exists, otherwise create it mkdir($TEST_DIR, 0755) unless -d $TEST_DIR; my $POS = tell DATA; # # process the modules foreach my $module (keys %MODULES) { logthis("=> Building $module test scripts ...\n"); process($module); logthis("\tdone\n"); } sub build_hash { /^(.*)\.pm/; my $pm_file = $1; return unless $pm_file; my $file = my $full_file = $File::Find::name; $file =~ s/^$LIB_DIR\///; $file =~ s/\.pm$//; my $test_file = my $module = $file; $module =~ s/\//\:\:/g; $test_file =~ s/\//\_/g; $test_file .= '.t'; $test_file = join '/', $TEST_DIR, $test_file; $MODULES{$module} = { file => $full_file, test_file => $test_file }; logthis("$module - $test_file\n"); } sub process { my $module = shift; return unless exists $MODULES{$module}; # # List of variables we _NEED_ my $MODULE = $module; my $TIME = scalar localtime; my $METHODS = undef; my @methods = (); open(PM, "< $MODULES{$module}->{file}") or die "couldn't read +$module: $!\n"; while(local $_ = <PM>) { while( /sub\s+([\w\d_]+)\s*\{/mg ) { push @methods, $1; } } close PM; $METHODS = join ' ', @methods; my $test_file = $MODULES{$module}->{test_file}; my $CUSTOM_DATA = get_custom_data($test_file); unless( length $CUSTOM_DATA ) { $CUSTOM_DATA =<<' EOD'; ###################################################### +########################## # This section is for more extensive testing of +the return values # # and functionality of the module and should be +comprehensive # ###################################################### +########################## # ================> PLEASE CUSTOMIZE THIS SECTION + <================ # #----------------------------------------------------- +-------------------------# EOD $CUSTOM_DATA =~ s/^\t+//mg; } open(TEST, "> $test_file") or die "couldn't write $test_file: +$!\n"; seek DATA, $POS, 0; while( local $_ = <DATA> ) { s/\@(\$[\w\d_]+)\@/$1/gee; print TEST; } print TEST $CUSTOM_DATA; close TEST; } sub get_custom_data { my $file = shift; return unless -f $file; return if $OPTS{O}; open( FILE, "< $file") or die "Couldn't open $file for reading +: $!\n"; while( local $_ = <FILE> ) { last if /^# ====> !!!! DO NOT ERASE THIS LINE !!!! <== +== #/; } local $/ = undef; my $data = <FILE>; return $data; } sub logthis { print @_ if $OPTS{v}; } sub help { print "usage: $0 [-hv] [-t testdir] [-d dir_to_search]\n", "-----------------------------------------------\n", " This script searches a lib directory and generates +generic\n", " test scripts for each module in the lib directory.\ +n\n", " options:\n", "\t -h display this menu and exit\n", "\t -v use verbose mode (prints as is + it goes)\n", "\t -O not recommended. Overwrite al +l files\n", "\t -t testdir store test files in testdir\n" +, "\t defaults to ./t/\n", "\t -d dir_to_search lib directory to search for mo +dules\n", "\t defaults to ./lib\n"; exit; } __DATA__ #!/usr/bin/perl # # AUTOGENERATED TEST SCRIPT FOR @$MODULE@ # # Built: @$TIME@ # by @$0@ written by Brad Lhotsky <brad.lhotsky@epokinc.com> # $|++; use strict; use Test::More qw(no_plan); ###################################################################### +########## # This section is basic module testing and should be completed + # ###################################################################### +########## # # make sure we can safely use the module BEGIN: { use_ok( '@$MODULE@' ); } # # test object creation via new my $obj; alarm 5; eval { local $SIG{ALRM} = sub { die 'timedout' }; $obj = new @$MODULE@; isa_ok( $obj, '@$MODULE@' ); }; alarm 0; if($@) { fail ( 'new() - create an object' ); diag( $@ ); } else { pass ( 'new() - create an object' ); } # # list of all public and private methods # can_ok($obj, qw/@$METHODS@/); # ====> !!!! DO NOT ERASE THIS LINE !!!! <==== #

Replies are listed 'Best First'.
Re: Autogenerate test scripts for your perl modules..
by hossman (Prior) on Aug 30, 2002 at 08:12 UTC
    FYI...

    I haven't tried this, but from skimming it (and referencing the perldocs) It doesn't appear that this won't accutally work with the most recent (ie: only) standalone release of Test::More (/MSCHWERN/Test-More-0.08) ... I'm guessing it's ment to work with the copy that comes with /JHI/perl-5.8.0 (v0.45)

      I used what was on the machine:
      [07:34:23 brad]$ perl -MTest::More -e 'print "Perl: $] Test::More: $Te +st::More::VERSION\n";' Perl: 5.006001 Test::More: 0.46

      I was also browsing the docs on the Test::* modules on perldoc.org and it matched up. Are there two modules with the same name space?

      -brad..
        Are there two modules with the same name space?

        Not so much differnt modules as different versions depending on what distrobution it was installed in.

        It's not uncommon -- especially when modules get rolled into the standared "perl" distrobution -- but normally the standalone distributions are still maintained and have the latest greatest features (ie: CPAN comes with perl, but you don't want to have to upgrade perl everytime you want the latest improvements to CPAN.)

        Test::More is a little unusual in that it has been included in a wide variety distributions -- everything from Wx to Palm::Progect to perl-5.8.0.

        Looking a little deeper right now, it looks like Test::More got rolled into the Test::Simple, and that's the new "definitive" distribution.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://193901]
Approved by particle
Front-paged by jarich
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (8)
As of 2024-04-23 10:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found