handle tests using TAP::Harness, how to print output when test exits - perl

I am trying the whole day to find out the answer, but I didn't find anything.
I wrote some tests using test::more (test1.t, test2.t, test3.t ...).
and I wrote a main perl script (main.pl) that handles all the tests using TAP::Harness and print the output in a JUnit format using formatter_class => 'TAP::Formatter::JUnit.
In my tests I use the BAIL_OUT function.
The problem is that when a test is bailed out, the main script also exits and there is no output at all. If, for example test3.t bailed_out, I need to see the results for test1.t and test2.t. how can I do that?
I can't use exit or die instead of BAIL_OUT because I don't want the other tests to continue. (If test3.t was BAIL_OUT I don't want that test4.t will run.)
can someone please help me?
I need to see the results for the tests that were running before the bailed out test.
Thanks.

According to the Test::More docs:
BAIL_OUT($reason);
Indicates to the harness that things are going so badly all testing should terminate.
This includes the running of any additional test scripts.
So that explains why your suite aborts.
You might want to consider die_on_fail from Test::Most, or skip_all, depending on the reason for the BAIL_OUT.
EDIT: Looks like Test::Builder doesn't have any intention of printing out a summary when it exits on "catastrophic failure" according to the source code:
sub BAIL_OUT {
my( $self, $reason ) = #_;
$self->{Bailed_Out} = 1;
$self->_print("Bail out! $reason");
exit 255;
}
# Don't do an ending if we bailed out.
if( $self->{Bailed_Out} ) {
$self->is_passing(0);
return;
}
However, that Bailed_Out flag is only ever used to consider printing out summary diagnostics, and since Test::More exposes the underlying Test::Builder object, you can probably just tweak the BAIL_OUT subroutine and no set this flag. All untested, of course; YMMV.

Instead of passing in all tests to one TAP::Harness, you need to pass in one test at a time to the Harness in case of a BAIL_OUT
I haven't seen your code, so here is a sample of what I mean. Adjust to include the formatter and whatever else you need.
use TAP::Harness;
my $harness = TAP::Harness->new({ merge => 0 });
my $tests = ['t/test1.t', 't/test2.t'];
foreach my $test (#$tests) {
eval {
$harness->runtests([$test]);
}; if ($#) {
# create new harness object if the previous fails catastrophically.
$harness = TAP::Harness->new({ merge => 0 });
}
}

Related

How to check if Archive::Tar's write is successful?

I have a monthly Script running to archive files from past month. I'm using Archive::Tar to generate the archive. How can I check if calls to the ->write method are successful?
Does the following work? I didn't manage to fail $tar->write() yet.
unless ($tar->write( $name . '.tar.xz', COMPRESS_XZ )) {
die("cant write tar"); # or any other doings instead
}
Yes, the code in your question will catch any error within ->write.
The documentation of Archive::Tar does not specify what the return value of write is (except when no argument is provided, which isn't the case here). However, looking at the code of the module, write returns undef in case of an error and a true value in case of success:
1 if it was writing to a file (this is the case for the code in your question)
the written string if it was writing in a string.
Note that if something goes wrong and Archive::Tar returns undef, then it will also print an error message (unless you set $Archive::Tar::WARN to 0 by doing $Archive::Tar::WARN = 0). If you want to do something specific depending on the error, you can access the error message using the ->error method.

What is Perl DBI difference between with bind_columns and without it?

What is the difference between the following code in perl dbi?
1.
while (my ($p1, $p2, $p3) = $sth->fetchrow_array()) {
# ... some code ...
}
2.
$sth->bind_columns(\my ($p1, $p2, $p3));
while ($sth->fetch) {
# ... some code ...
}
Both leads to the same result.
Perlmonks advise on bind variant.
I would appreciate if someone explain why.
the docs says, that binding is more efficient way to fetch data:
The binding is performed at a low level using Perl aliasing. Whenever
a row is fetched from the database $var_to_bind appears to be
automatically updated simply because it now refers to the same memory
location as the corresponding column value. This makes using bound
variables very efficient.

How to skip 'die' in perl

I am trying to extract data from website using perl API. The process is to use a list of uris as input. Then I extract related information for each uri from website. If the information for one uri is not present it dies. Some thing like the code below
my #tags = $c->posts_for(uri =>"$currentURI");
die "No candidate related articles\n" unless #tags;
Now, I don't want the program to stop if it doesn't get any tags. I want the program to skip that particular uri and go to the next available uri. How can i do it?
Thank you for your time and help.
Thank you,
Sammed
Well, assuming that you're inside a loop processing each of the URIs in turn, you should be able to do something like:
next unless #tags;
For example, the following program only prints lines that are numeric:
while (<STDIN>) {
next unless /^\d+$/;
print;
}
The loop processes every input line in turn but, when one is found that doesn't match that regular expression (all numeric), it restarts the loop (for the next input line) without printing.
The same method is used in that first code block above to restart the loop if there are no tags, moving to the next URI.
Besides the traditional flow control tools, i.e. next/last in a loop or return in a sub, one can use exceptions in perl:
eval {
die "Bad bad thing";
};
if ($#) {
# do something about it
};
Or just use Try::Tiny.
However, from the description of the task it seems next is enough (so I voted for #paxdiablo's answer).
The question is rather strange, but as near as I can tell, you are asking how to control the flow of your current loop. Of course, using die will cause your program to exit, so if you do not want that, you should not use die. Seems elementary to me, that's why it is a strange questions.
So, I assume you have a loop such as:
for my $currentURI (#uris) {
my #tags = $c->posts_for(uri =>"$currentURI");
die "No candidate related articles\n" unless #tags;
# do stuff with #tags here....
}
And if #tags is empty, you want to go to the next URI. Well, that's a simple thing to solve. There are many ways.
next unless #tags;
for my $tag (#tags) { ... stuff ... }
if (#tags) { .... }
Next is the simplest one. It skips to the end of the loop block and starts with the next iteration. However, using a for or if block causes the same behaviour, and so are equivalent. For example:
for my $currentURI (#uris) {
my #tags = $c->posts_for(uri =>"$currentURI");
for my $tag (#tags) {
do_something($tag);
}
}
Or even:
for my $currentURI (#uris) {
for my $tag ($c->posts_for(uri =>"$currentURI")) {
do_something($tag);
}
}
In this last example, we removed #tags all together, because it is not needed. The inner loop will run zero times if there are no "tags".
This is not really complex stuff, and if you feel unsure, I suggest you play around a little with loops and conditionals to learn how they work.

Can't get Extended SNMP output in Perl

I have written a Perl script to put back some SNMP values, which works fine. I have now written a script on the remote server and used the extend function in SNMP to put the value from the script into SNMP.
If I run:
snmpget -v2c -c public 10.0.0.10 'NET-SNMP-EXTEND-MIB::nsExtendOutput1Line."cc_power"'
I get the result:
NET-SNMP-EXTEND-MIB::nsExtendOutput1Line."cc_power" = STRING: 544
But when I try to use my script to get the information back it doesn't get it. Here is the script:
#!/usr/bin/perl
use strict;
use SNMP;
use RRDs;
my $rrd_db = "/storage/db/rrd/cc_power.rrd";
my $sess;
my $val;
my $error;
$sess = new SNMP::Session(DestHost => "10.0.0.10", Community => "public", Version => 2);
my $power = $sess->get('NET-SNMP-EXTEND-MIB::nsExtendOutput1Line.\"cc_power\"');
$error=RRDs::error;
die "ERROR while updating RRD: $error\n" if $error;
my $date=time;
print "Data Script has been run - Output: ${date}:${power}\n";
but nothing is returned, and I have no idea why... no errors or anything, have I missed something stupid?
Hope someone can help as this is driving me nuts :)
I assume that you used netsnmp snmpget. Well, it hides too many details from you, as it loads MIB documents in background and nicely translate OIDs and SNMP values to all kinds of user friendly formats.
So next time pay attention to what decoration it performs and simulate that in your own code to achieve the same effects.

How much do I need to test Moose- and MooseX::FollowPBP-generated methods?

I want to start strictly doing Test-Driven-Development. However, I was wondering how much I should test methods generated by Moose and MooseX::FollowPBP. For example, I have the following class:
package Neu::Series;
use Moose;
use MooseX::FollowPBP;
use File::Find::Wanted;
has 'file_regex' => (
isa=>'RegexpRef',
is=>'rw',
default => sub{
qr{
[A-Z] #Uppercase letter
[a-zA-Z]* #any letter, any number of times
[-] #dash
( #open capturing parenthesis
[0-9]
[0-9]
[0-9]
[0-9]
[a-zA-Z]? #any letter, optional
) #close capturing parenthesis
}xms;
},
);
has 'top_dir' => (
isa=>'Str',
is=>'rw',
);
has 'access' =>(
isa=>'Neu::Access',
is=>'ro',
required=>1,
);
1;
My current test script is:
use strict;
use warnings;
use Test::More tests => 8;
use Neu::Access;
BEGIN{ use_ok('Neu::Series'); }
can_ok( 'Neu::Series', 'new');
can_ok( 'Neu::Series', 'set_file_regex');
can_ok( 'Neu::Series', 'get_file_regex');
can_ok( 'Neu::Series', 'set_top_dir');
can_ok( 'Neu::Series', 'get_top_dir');
can_ok( 'Neu::Series', 'get_access');
my $access = Neu::Access->new(dsn => 'test');
my $series_worker = Neu::Series->new(access => $access);
isa_ok($series_worker, 'Neu::Series');
Is this enough or too-much testing? (That is, besides the obviously missing tests for the regex).
I thought I saw a web page or another post about this somewhere, but I haven't been able to find it today.
There's really no point in testing that the accessors were generated correctly. If they're not, you'll find out very quickly, because any real tests you write will fail.
Moose itself tests that accessors are generated correctly, that Moose-using classes get a constructor, and so on. One of the points of using dependencies is so that you can focus on writing and testing your application, not helper code.
I do agree with daotoad, it's probably worth testing constraints and coercions that you write yourself.
Checking that all accessors were generated correctly is fine... however there are other things you could test at a slight higher level, e.g. why not test that the attributes were generated properly?
use Test::Deep;
my #attrs = Neu::Series->meta->get_all_attributes;
cmp_deeply( [ map { $_->name } #attrs ], superbagof(qw(file_regex top_dir access)));
I'd focus on testing my specification. Did I tell Moose what I wanted it to do correctly?
To this end, I'd start with the following tests:
Verify that read/write attributes have both an accessor and a mutator.
Verify that read only attributes have an accessor and no mutator.
Test any type constraints and coercions. Verify that only acceptable values can be set. If an attribute sIf you expect VII to be seen as a Str and coerced into an Int as 7, test that it does.
Thank you Dave, daotoad, Ether, Elliot, and brian. From reading your answers, comments, and blogs, there seem to be two salient points:
(1) No testing is needed to make sure Moose does what it is supposed to do. I think everyone agrees on this point.
(2) Testing Moose-generated methods is appropriate for establishing, testing, and maintaining your interface. Most agree on this point.
Again, thanks to everyone for your input.
EDIT:
This is just a community-wiki summary. Please read the individual answers and comments.