Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Looking for help for unit tests and code coverage on an existing perl script

by tizatron (Initiate)
on Jan 31, 2014 at 22:40 UTC ( #1072921=perlquestion: print w/replies, xml ) Need Help??

tizatron has asked for the wisdom of the Perl Monks concerning the following question:

Greetings,

Someone passed me a perl script to look at and I quickly realized that I needed to get a test around it. I had never used the Test::More module and I wanted to get some feedback, any tips and some comments.

I watered down the script greatly. Essentially:

$ ./sample.pl my-dev-1 --- classes: - all - dev
The script accepts a hostname and spits out a list of classes. Here's the code:
#!/usr/bin/perl use strict; use warnings; use YAML qw( Dump ); use Getopt::Std; use constant { true => 1, false => 0 }; use Data::Dumper; my $deploy = 'common'; my $host = 'unknown'; my $fullhost = 'none'; my @classes = (); my %args = (); getopts( 'hr:', \%args ); sub usage { my $heredoc = <<EOF; Usage: sample.pl [-h] hostname [ -h ] print this help message EOF print $heredoc; return $heredoc; } # main if (@ARGV == 0) { print "no args\n"; } else { $fullhost = $ARGV[$#ARGV]; $fullhost =~ s/^.*:://; if ( $fullhost =~ /(\w+)-(.*)/ ) { ( $deploy, $host ) = ( $1, $2 ); } } if ( $args{h} ) { usage() } if ( $deploy =~ /^my$/ ) { # Pushing global classes push( @classes, 'all' ); if ( $host =~ /build-/ ) { push( @classes, 'build' ); } # Pushing Dev Classes if ( $host =~ /dev-/ ) { push( @classes, 'dev' ); } } else { push( @classes, 'base' ); } print Dump( { classes => \@classes, } );

So, now I want to wrap some cover and tests around this script. I wrote a little test.pl script as a first attempt.

#!/usr/bin/perl use warnings; use strict; use Test::More tests => 2; use Test::Output; require_ok( "./sample.pl"); is(&usage(), " Usage: sample.pl [-h] hostname [ -h ] print this help message ", 'check usage message'); done_testing();

Seems to run ok (no pun intended)

$ ./test.pl 1..2 no args --- classes: - base ok 1 - require './sample.pl'; Usage: sample.pl [-h] hostname [ -h ] print this help message ok 2 - check usage message

However, now I start to get the feeling that I am doing something wrong. I had to add a return() to the usage function to get that test to pass. Not sure if there is a better way to do that.

I tried the run the code coverage

---------------------------- ------ ------ ------ ------ ------ ------ ------
File                           stmt   bran   cond    sub    pod   time  total
---------------------------- ------ ------ ------ ------ ------ ------ ------
sample.pl                     100.0    n/a    n/a  100.0    n/a    3.1  100.0
test.pl                       100.0    n/a    n/a  100.0    n/a   96.9  100.0
Total                         100.0    n/a    n/a  100.0    n/a  100.0  100.0
---------------------------- ------ ------ ------ ------ ------ ------ ------

Ok - that really looks wrong. How can I have 100 percent code coverage?

This is where I decided to take a break and do some research and study and make sure I driving in the right direction.

So a couple of questions:

1. Quick review so far - what am missing? Is this the right setup? I understand that a lot of testing in perl works around modules. I just have a script to work with. My goal is to wrap some testing around what I have, and attempt to drive it to something more modular

2. How do I start testing the implied main?

Any thoughts or comments welcomed.

Replies are listed 'Best First'.
Re: Looking for help for unit tests and code coverage on an existing perl script
by kcott (Bishop) on Feb 01, 2014 at 00:55 UTC

    G'day tizatron,

    Given that you're really just testing output from your script, Test::Output seems like a good choice; however, although you've loaded that module, you haven't used any of its functionality.

    When I read "return $heredoc;", I wondered what this was for (it seemed pointless). I do see that you've questioned this yourself: "I had to add a return() to the usage function to get that test to pass ...". If your tests identify logic errors (or similar) in the code you're testing, then do fix the code; however, don't add questionable code just to make the tests pass.

    Here's an example of how you might go about interspersing Test::More and Test::Output tests.

    Sample production script (pm_script_testing.pl):

    #!/usr/bin/env perl use strict; use warnings; usage() unless @ARGV; print scalar(@ARGV), ": @ARGV\n"; sub usage { warn "Argument required!\n"; exit; }

    Sample test script (pm_script_testing.t):

    #!/usr/bin/env perl use strict; use warnings; use Test::More tests => 4; use Test::Output; stderr_is { qx{perl -c pm_script_testing.pl} } "pm_script_testing.pl syntax OK\n", 'Test Syntax'; stderr_is { qx{pm_script_testing.pl} } "Argument required!\n", 'Test Zero Arguments'; is(qx{pm_script_testing.pl 123}, "1: 123\n", 'Test One Argument'); stdout_is { system qw{pm_script_testing.pl 123 qwe} } "2: 123 qwe\n", 'Test Two Arguments';

    Output:

    $ pm_script_testing.t 1..4 ok 1 - Test Syntax ok 2 - Test Zero Arguments ok 3 - Test One Argument ok 4 - Test Two Arguments

    If you haven't done so already, you may benefit from reading Test::Tutorial.

    -- Ken

      Ken,

      Your points on Test::Output are well taken. I was experimenting with that module and did get some results via sterr_is and stdout_is.

      The 'is' statement only evaluates a return, so your patterns using Test::Output are much more useful in this context.

      What I really need out of the test suite is code coverage. I pulled down your code and ran the tests. I tried to run something like:

      $ perl -MDevel::Cover pm_script_testing.pl $ cover
      I was able to spit out some code coverage numbers. I am going to try spend some time on this path and see I can get it to fly on my test script. But I need to dig in a little more and see if Test::Output aligns with Devel::Cover like I hope it does.
Re: Looking for help for unit tests and code coverage on an existing perl script
by eyepopslikeamosquito (Chancellor) on Feb 01, 2014 at 09:55 UTC

    I would extract a module from your script and unit test the module directly via Test::More and the prove command. I like to keep my script mainlines as short as is practicable, with all the heavy lifting done in (unit-tested) module/s. There are many examples of this general approach on the CPAN; see, for example, the perltidy command, part of the Perl-Tidy distribution and the perlcritic command, part of the Perl-Critic distribution.

    As an alternative, and perhaps a bit less work, you could re-structure your script as a "modulino", that is, a script that can masquerade as a module for ease of testing. This approach is described at:

    See also: How do you test end-user scripts?

      Good links there. Appreciate it.

      In this theme, I went ahead and tried to setup an env similar to the layout described in this link:

      StackOverFlow Complete build/unittest/codecoverage

      couple of things that I did:

      • Created the layout described. Made directories for 'lib' and 't'.
      • Copied my script to lib. Flipped the extension to pm. Added a package statement to the script. Also added: __PACKAGE__->main( @ARGV ) unless caller();
      • Wrapped the main block of code, what I called the implied main, in sub main{...}

      Then I was able to add a stanza to my test file.

      my $my_dev_1 = sample::main("my-dev-1"); is($my_dev_1, "--- classes: - all - dev ", "my dev 1 test");

      Not sure how I feel about the sample::main("my-dev-1"). Would appreciate some feedback on that to see if I am calling this correctly.

      That said, I was able to generate code cover from this setup.

      $ ./Build test
      $ ./Build testcover
      

      ---------------------------- ------ ------ ------ ------ ------ ------ ------
      File                           stmt   bran   cond    sub    pod   time  total
      ---------------------------- ------ ------ ------ ------ ------ ------ ------
      blib/lib/sample.pm             97.4   91.7    n/a  100.0    0.0  100.0   93.2
      Total                          97.4   91.7    n/a  100.0    0.0  100.0   93.2
      ---------------------------- ------ ------ ------ ------ ------ ------ ------
      

      That processes pumps out a cover.html file that kinda aligns more with what I was hoping to see. The changes to the original code are not significant, but they are changes, more than what I was hoping to make, perhaps digging in harder on Test::Output would help.

Re: Looking for help for unit tests and code coverage on an existing perl script
by dasgar (Priest) on Feb 01, 2014 at 00:25 UTC

    I can't offer suggestions/tips on testing. Haven't gotten into using tests like I probably should.

    As for trying to figure out your test coverage, you may want to check out Devel::Cover.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1072921]
Approved by keszler
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (3)
As of 2019-09-15 12:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The room is dark, and your next move is ...












    Results (180 votes). Check out past polls.

    Notices?