Unit test for testing Perl script/module exceptions and dieing - perl

I am trying to create unit tests for my script using the Test::More and Test::Exception libraries.
I have read these articles How to test for exceptions in Perl and Test::Exception.
The first article describes exactly what I need, to test my subroutine for throwing exception or dieing.
But I cannot get it working. Consider some examples
#!/usr/bin/env perl
package My::SuperModule;
use strict;
use warnings;
use Net::Ping;
use Utils::Variables::Validator;
sub new
{
die "Hello";
#Getting class name from, stored in $_[0]
my $class = shift;
#Getting user name from arguments $_[1]
my $user_name = shift;
........
}
And my test file
use warnings; # this warns you of bad practices
use strict; # this prevents silly errors
use Test::More; # for the is() and isnt() functions
use Test::Exception;
do './My/SuperModule.pm';
#Testing module loading
print "=================Testing module loading=================\n";
use_ok ( 'My::SuperModule' );
use_ok ( 'My::SuperModule', 'new' );
#Testing module subroutines
dies_ok { My::SuperModule->new() } "Died in class constructor";
sub div {
my ( $a, $b ) = #_;
return $a / $b;
};
dies_ok { div( 1, 0 ) } 'divide by zero detected';
It stops executing script in any case, but I need just to handle if died, I need to test this because I manually invoke die if data is invalid or something other , but it dies and doesn't continue to execute the script further. Giving me a message
Uncaught exception from user code:
Hello at ../libs/My/SuperModule.pm line 31.
My::SuperModule::new('My::SuperModule', '') called at SuperModule.t line 24
# Tests were run but no plan was declared and done_testing() was not seen.
# Looks like your test exited with 2 just after 8.
But if to use division by zero it works like I want
ok 16 - divide by zero detected
So it fails but doesn't terminate execution of the script.
I am newbie in Perl, so cannot solve the problem by myself, maybe there is not problem at all, just no way to do what I want.
Please suggest what to do or say where is my fault here.
EDIT
I have just tried to divide by zero inside my module new subroutine and here is the message I got.
Illegal division by zero at ../libs/My/SuperModule.pm line 33 (#1)
(F) You tried to divide a number by 0. Either something was wrong in
your logic, or you need to put a conditional in to guard against
meaningless input.
I really cannot figure out what is going on. Please help with this.

Here is a minimal example that works:
package My::SuperModule;
use strict;
use warnings;
sub new {
die "Hello";
}
package main;
run() unless caller;
use Test::More;
use Test::Exception;
sub run {
dies_ok { My::SuperModule->new } "dies ok";
done_testing;
}
Output:
C:\...\t> prove -v my.pl
my.pl ..
ok 1 - dies ok
1..1
ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.09 usr + 0.00 sys = 0.09 CPU)
Result: PASS
Note that, for the purpose of providing a self-contained example, I combined the module code and the test script into a single file.
Also note that I did not clutter the test script with unnecessary print statements.
If you want, you can use diag to show some output:
diag "Checking if Test::Exception::dies_ok will catch die in new";
dies_ok { My::SuperModule->new } "dies ok";
done_testing;
Output:
C:\...\t> prove my.pl
my.pl .. # Checking if Test::Exception::dies_ok will catch die in new
my.pl .. ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.05 usr + 0.02 sys = 0.06 CPU)
Result: PASS
As opposed to plain print statements, diag output will actually be shown when tests are run from a harness such as prove.

It works for me. All I needed to do was:
Comment out the two modules that the test wasn't using (Net::Ping and Utils::Variables::Validator - I don't have them installed).
Add 1; as the last line of the module - so it returns a true value.
Remove the extra require and use_ok from the test.
Added done_testing; to the end of the test - so the test harness knows that it got to the end of the tests.
You probably don't care about the first item on that list, but if you fix the others, it should work for you.

Related

How to implement assert in Perl?

When trying to implement C's assert() macro in Perl, there is some fundamental problem. Consider this code first:
sub assert($$) {
my ($assertion, $failure_msg) = #_;
die $failure_msg unless $assertion;
}
# ...
assert($boolean, $message);
While this works, it's not like C: In C I'd write assert($foo <= $bar), but with this implementation I'd have to write assert($foo <= $bar, '$foo <= $bar'), i.e. repeat the condition as string.
Now I wonder how to implement this efficiently. The easy variant seems to pass the string to assert() and use eval to evaluate the string, but you can't access the variables when evaluating eval. Even if it would work, it would be quite inefficient as the condition is parsed and evaluated each time.
When passing the expression, I have no idea how to make a string from it, especially as it's evaluated already.
Another variant using assert(sub { $condition }) where it's likely easier to make a string from the code ref, is considered too ugly.
The construct assert(sub { (eval $_[0], $_[0]) }->("condition")); with
sub assert($)
{
die "Assertion failed: $_[1]\n" unless $_[0];
}
would do, but is ugly to call.
The solution I am looking for is to write the condition to check only once, while being able to reproduce the original (non-evaluated) condition and efficiently evaluate the condition.
So what are more elegant solutions? Obviously solutions would be easier if Perl had a macro or comparable syntax mechanism that allows transforming the input before compiling or evaluating.
Use B::Deparse?
#!/usr/bin/perl
use strict;
use warnings;
use B::Deparse;
my $deparser = B::Deparse->new();
sub assert(&) {
my($condfunc) = #_;
my #caller = caller();
unless ($condfunc->()) {
my $src = $deparser->coderef2text($condfunc);
$src =~ s/^\s*use\s.*$//mg;
$src =~ s/^\s+(.+?)/$1/mg;
$src =~ s/(.+?)\s+$/$1/mg;
$src =~ s/[\r\n]+/ /mg;
$src =~ s/^\{\s*(.+?)\s*\}$/$1/g;
$src =~ s/;$//mg;
die "Assertion failed: $src at $caller[1] line $caller[2].\n";
}
}
my $var;
assert { 1 };
#assert { 0 };
assert { defined($var) };
exit 0;
Test output:
$ perl dummy.pl
Assertion failed: defined $var at dummy.pl line 26.
There are a load of assertion modules on CPAN. These are open source, so it's pretty easy to peek at them and see how they're done.
Carp::Assert is a low-magic implementation. It has links to a few more complicated assertion modules in its documentation, one of which is my module PerlX::Assert.
Use caller and extract the line of source code that made the assertion?
sub assert {
my ($condition, $msg) = #_;
return if $condition;
if (!$msg) {
my ($pkg, $file, $line) = caller(0);
open my $fh, "<", $file;
my #lines = <$fh>;
close $fh;
$msg = "$file:$line: " . $lines[$line - 1];
}
die "Assertion failed: $msg";
}
assert(2 + 2 == 5);
Output:
Assertion failed: assert.pl:14: assert(2 + 2 == 5);
If you use Carp::croak instead of die, Perl will also report stack trace information and identify where the failing assertion was called.
One approach to any kind of "assertions" is to use a testing framework. It isn't as clean-cut as C's assert but then it is incomparably more flexible and manageable, while tests can still be freely embedded in code much like assert statements are.
A few very simple examples
use warnings;
use strict;
use feature 'say';
use Test::More 'no_plan';
Test::More->builder->output('/dev/null');
say "A few examples of tests, scattered around code\n";
like('may be', qr/(?:\w+\s+)?be/, 'regex');
cmp_ok('a', 'eq', 'a ', 'string equality');
my ($x, $y) = (1.7, 13);
cmp_ok($x, '==', $y, '$x == $y');
say "\n'eval' expression in a string so we can see the failing code\n";
my $expr = '$x**2 == $y';
ok(eval $expr, 'Quadratic') || diag explain $expr;
# ok(eval $expr, $expr);
with output
A few examples of tests, scattered around code
# Failed test 'string equality'
# at assertion.pl line 19.
# got: 'a'
# expected: 'a '
# Failed test '$x == $y'
# at assertion.pl line 20.
# got: 1.7
# expected: 13
'eval' expression in a string so we can see the failing code
# Failed test 'Quadratic'
# at assertion.pl line 26.
# $x**2 == $y
# Looks like you failed 3 tests of 4.
This is just a scattershot of examples, where the last one answers the question directly.
The module Test::More brings together a number of tools; there are many options in how to use it and how to manipulate output. See Test::Harness, and Test::Builder (used above), and a number of tutorials and SO posts.
I don't know how the above eval counts toward "elegant" but it does move you from singular and individually cared for C-style assert statements toward a more easily manageable system.
Good assertions are meant and planned as systemic tests and code documentation but by their nature lack formal structure (and so may still end up scattered and ad-hoc). When done this way they come with a framework and can be managed and tuned with many tools, and as a suite.

Test::Most - report failed test with stacktrace

I'm fixing a large test script (> 1000 lines) that uses some utility methods (also > 1000 lines) to perform repeated tests on various initial data setups. This helps consolidate code. However, when a test fails it reports the line number of inside the utility method making it hard to trace which test failed.
Is it possible to configure Test::Most to give a stacktrace instead of just a single line number when a test fails?
#!/usr/bin/env perl
use strict;
use warnings;
use autodie;
use Test::Most tests => 3;
ok(1, 'first test');
note "The following includes a failed test, but a stack trace would be more helpful";
helper_sub_with_test(); # Line 13
ok(1, 'third test');
sub helper_sub_with_test {
ok(0, "second test"); # Line 17
}
Outputs:
$ perl scratch.pl
1..3
ok 1 - first test
# The following includes a failed test, but a stack trace would be more helpful
not ok 2 - second test
# Failed test 'second test'
# at scratch.pl line 17.
ok 3 - third test
# Looks like you failed 1 test of 3.
As you can see, it would be helpful if the failed test reported both line 17 and line 13 for when there are multiple calls to the utility method.
I don't believe that the Test::More infrastructure provides such a beastie, but do you really need a stack trace? Reporting line 13 alone should be sufficient, provided you give your tests descriptive names.
To report line 13 instead of line 17, just add the following to your sub:
local $Test::Builder::Level = $Test::Builder::Level + 1;
Longer example:
#!/usr/bin/env perl
use strict;
use warnings;
use autodie;
use Test::Most tests => 3;
ok(1, 'first test');
note "The following includes a failed test, but a stack trace would be more helpful";
helper_sub_with_test(); # Line 13
ok(1, 'third test');
sub helper_sub_with_test {
local $Test::Builder::Level = $Test::Builder::Level + 1;
ok(0, sprintf "second test (look at line %d)", __LINE__); # Line 18
}
The quick and dirty way to get what you want is to put a wrapper around Test::Builder::ok. This is how Test::Most operates.
Using Aspect makes this less of a hack.
use Carp qw(longmess);
use Test::Most;
use Aspect;
after {
# For some reason, the return value is not being captured by Aspect
my $last_test = ($_->self->summary)[-1];
print longmess if !$last_test;
} call "Test::Builder::ok";
sub foo { ok(0) }
foo();
pass;
done_testing;

passing parameters with perl using reflection

I have the following Perl module:
package module
sub test1{
my #data=#_
print #data;
}
When I call this module from a Perl script using:
my $test='test1';
my $full_name = "Module::" . $test;
my #data=(1,2,3)
no strict 'refs';
$full_name->(#data);
I get no result on stdout but I expected 1,2,3. Could someone explain why?
It sounds like you are not setting up your module properly.
Running the following self contained script produces the correct result:
{package Module;
sub test1 {print "test1: #_\n"}
}
my $test = 'test1';
my $full_name = 'Module::'.$test;
my #data = (1, 2, 3);
no strict 'refs';
$full_name->(#data); # test1: 1 2 3
It is hard to tell without seeing exactly what you have, but chances are you have forgotten to include the package Module; line at the top of your module. The package is not implicitly set via the file name, you must declare it at the top of the file.

Script dies if a module that doesnt exist is used during sort() - DateTime::TimeZone::Local example

use DateTime::TimeZone::Local;
use Test::More tests => 1;
my #input = (1 .. 10 );
my (#output) = sort {
DateTime::TimeZone::Local->TimeZone();
$a cmp $b
} #input;
is_deeply(\#output, \#input);
Output:
1..1
Can't return outside a subroutine at /usr/local/share/perl/5.8.8/DateTime/TimeZone/Local.pm line 72.
# Looks like your test exited with 9 before it could output anything.
shell returned 9
I have checked and it definitely is inside a sub routine. It doesn't appear to be anything to do with the module used, this code also causes the same error:
my #output = sort {
sub1();
} (1 .. 5);
sub sub1 {
eval "use ModuleDoesntExist";
return 1; # remove this and get a seg fault
}
Looks like it is a bug in perl more than anything. Any ideas? More interested in why this is happening than a workaround - it only occurs if the module doesn't exist.
It looks as though it is actually a bug in Perl. See this thread on the Perl Porters list.

How can I monitor the Perl call stack?

I'm using ActivePerl 5.8 on Windows XP.
use strict;
use warnings;
use Data::Dumper;
There are three subroutines used in my script.
To detect the call stack, I can only insert some print "some location"; and check the print result from console Window.
Is there any good method to monitor it? Thank you.
If it's your code, you might want to use:
Carp::cluck( "And here's the stack:" );
See Carp::cluck. It prints out a warning with a stack trace. It works like the "printf" style of debug output.
Use the debugger's T command.
Example:
$ perl -d -e'
sub foo {}
sub bar { foo; }
bar;
'
Loading DB routines from perl5db.pl version 1.32
Editor support available.
Enter h or `h h' for help, or `man perldebug' for more help.
main::(-e:4): bar;
DB<1> s
main::bar(-e:3): sub bar { foo; }
DB<1> s
main::foo(-e:2): sub foo {}
DB<1> T
. = main::foo() called from -e line 3
. = main::bar() called from -e line 4
DB<1> s
Debugged program terminated. Use q to quit or R to restart,
use o inhibit_exit to avoid stopping after program termination,
h q, h R or h o to get additional info.
DB<1> q
You weren't specific about why you'd like to monitor the call stack and trace your subs, so answers will have to be broad.
One method is caller:
caller
Returns the context of the current subroutine call. In scalar context, returns the caller's package name if there is a caller, that is, if we're in a subroutine or eval or require, and the undefined value otherwise. In list context, returns
# 0 1 2
($package, $filename, $line) = caller;
With EXPR, it returns some extra information that the debugger uses to print a stack trace. The value of EXPR indicates how many call frames to go back before the current one.
# 0 1 2 3 4
($package, $filename, $line, $subroutine, $hasargs,
# 5 6 7 8 9 10
$wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
= caller($i);
You might also use the Devel::Cover module:
Code coverage data are collected using a pluggable runops function which counts how many times each op is executed. These data are then mapped back to reality using the B compiler modules. There is also a statement profiling facility which needs a better backend to be really useful.
The more you tell us about what you want to do, the more helpful to you our answers will be!
You rarely need to directly manage the call stack in Perl. If you do caller is the tool you want. However, it is only rarely needed.
More often, I want to see a stack trace when I am debugging. Good news, its easy to get a stack trace, simply use Carp's confess and cluck functions instead of die and warn.
use strict;
use warnings;
use Carp;
bar(6.1);
bar(1);
sub foo {
confess "Oh noes" unless #_ == 6; # confess is fatal
}
sub bar {
my $count = shift;
cluck "bar is in trouble" unless int $count == $count; # cluck is not fatal
foo( ('a')x $count );
}
This gets you:
dao:~ toad$ perl test.pl
bar is in trouble at test.pl line 14
main::bar(6.1) called at test.pl line 5
Oh noes at test.pl line 9
main::foo('a') called at test.pl line 15
main::bar(1) called at test.pl line 6