I have a simple test file under t/. I want to display the summary after running all the tests. For some reason, the summary is displayed before the results of "04.pl" is displayed. How do I display the summary after running all the tests?
==> t/test.t
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
plan tests => 4;
require "/home/mydir/perl5/lib/perl5/TAP/Harness.pm";
require "/home/mydir/perl5/lib/perl5/TAP/Formatter/HTML.pm";
require "/home/mydir/perl5/lib/perl5/TAP/Parser/Aggregator.pm";
my $f = TAP::Formatter::HTML->new;
$f->verbosity(-1);
$f->force_inline_css(0);
my %args = (
formatter => $f,
merge => 1,
);
my $a = TAP::Parser::Aggregator->new;
my $h = TAP::Harness->new(\%args);
my #files = qw[01.pl 02.pl 03.pl 04.pl];
$a->start;
$h->aggregate_tests($a, #files);
$a->stop;
done_testing(4);
my $summary = <<'END_SUMMARY';
Total Tests: %s
Passed: %s
Failed: %s
Unexpectedly succeeded: %s
END_SUMMARY
printf $summary,
scalar $a->total,
scalar $a->passed,
scalar $a->failed,
scalar $a->todo_passed;
==> Output (in html format)
1..4
ok 1 - First
ok 1 - Second
ok 1 - Third
Total Tests: 4
Passed: 4
Failed: 0
Unexpectedly succeeded: 0
ok 1 - Four
To run the tests, I used the 'prove' utility:
/home/mydir/perl5/bin/prove -Q --formatter=TAP::Formatter::HTML > output.html
The following command will run all the .t files in the t/ subdirectory merging the STDOUT and STDERR (-m) and running quietly (-Q).
prove -m -Q --state=last --formatter=TAP::Formatter::HTML t/ > output.html
The simpliest way to execute it in Perl is:
$output = `prove -m -Q --state=last --formatter=TAP::Formatter::HTML t/`;
Take a look at http://perldoc.perl.org/prove.html#--state to see all possibilities of --state parameter.
Related
We have a project where we run a couple of tests with a duration of around 3 hours. And I have observed that a lot of minutes are lost in the step of generation the results. For example:
I have this script harness.pl
use strict;
use TAP::Harness;
use TAP::Formatter::HTML;
use TAP::Formatter::Console;
# Define Tests
my $tests = {
"test_1" => {
test => 'script.t',
args => ['--server', "server_1"]
},
# "test_2" => {
# test => 'script.t',
# args => ['--server', "server_2"]
# },
};
# Get arguments
my $test_args = {};
$test_args->{$_} = $tests->{$_}->{args} foreach (sort keys %$tests);
# Define formatter
# my $fmt = TAP::Formatter::HTML->new();
# $fmt->output_file( "report.html" );
my $fmt = TAP::Formatter::Console->new({verbosity=>1});
# Start testing
my $harness = TAP::Harness->new( {
test_args => $test_args,
formatter => $fmt,
merge => 1,
jobs => 1,
} );
my $result = $harness->runtests(get_tests($tests));
print( "$0 Run Time: " . ( time - $^T ) . " second(s).\n");
print "Passed: ". scalar $result->passed . "\n";
print "Failed: ". scalar $result->failed . "\n";
print "Errors: ". scalar $result->has_errors . "\n";
sub get_tests{
my ($tests) = #_;
my #tests_to_run;
TEST: foreach my $test (sort keys %$tests){
# some filtering...
push #tests_to_run, [$tests->{$test}->{test}, $test]
}
# some prints...
return #tests_to_run;
}
And a couple of test, lets take an example of the following script.:
use strict;
use warnings;
use Test::More;
use Getopt::Long qw(GetOptions);
my ($server);
GetOptions(
'server|s=s' => \$server,
) or die "[ERROR] Invalid options passed to $0\n";
my $number_of_tests = 100000;
plan tests => 2 + $number_of_tests;
ok (1, "start");
foreach my $test_nr (0..$number_of_tests-1){
ok(1,"Test numbber: $test_nr in $server");
}
ok ($server eq 'server_1', "Finished");
done_testing;
print( "$0 Run Time: " . ( time - $^T ) . " second(s).\n");
Now I run the tests with the reports of HTML:
# Define formatter
my $fmt = TAP::Formatter::HTML->new();
$fmt->output_file( "report.html" );
And I get the following results:
ok 100002 - Finished
script.t Run Time: 34 second(s).
harness.pl Run Time: 42 second(s).
Passed: 100002
Failed: 0
Errors: 0
So 8 seconds after finishing the script.
After that I tried with the default console formatter:
# Define formatter
my $fmt = TAP::Formatter::Console->new({verbosity=>1});
And the result:
ok 100002 - Finished
script.t Run Time: 34 second(s).
ok
All tests successful.
Files=1, Tests=100002, 34 wallclock secs (16.20 usr + 3.61 sys = 19.81 CPU)
Result: PASS
harness.pl Run Time: 34 second(s).
Passed: 100002
Failed: 0
Errors: 0
So this looks quite good, this makes me think that the issue comes from creating a really big HTML report which in this example would generate a 13,854 KB HTML file.
So I go outside of this simple example to my project. And run a simplifed version my test which generates a report like the following:
As you can see it is not a cray amount of tests, just around 35 with a file of 35 KB I don't think anything which could have many computing issues.
And then I look at the logs with the same structure where I print the last line of the script and I get this cray difference of time:
t/long-test.t Run Time: 117 second(s).
# Looks like you failed 2 tests of 34.
Passed: 32
Failed: 2
Errors: 2
Harness.pl Run Time: 212 second(s).
The I think again, ok something must be wrong with this HTML library. So I go full on it and remove the HTML report and use just the console formatter:
# at t/mylongtest.t line 237.
t/mylongtest.t Run Time: 128 second(s).
# Looks like you failed 2 tests of 34.
Dubious, test returned 2 (wstat 512, 0x200)
Failed 2/34 subtests
Test Summary Report
-------------------
mylongtest (Wstat: 512 Tests: 34 Failed: 2)
Failed tests: 33-34
Non-zero exit status: 2
Files=1, Tests=34, 215 wallclock secs ( 0.22 usr + 0.12 sys = 0.34 CPU)
Result: FAIL
Passed: 32
Failed: 2
Errors: 2
Harness.pl Run Time: 216 second(s).
And then again I get this cray difference from 128 seconds from the end of the test to 216 seconds at the end of the harness.
The I tried to remove completly the harness script and just use prove and I get the same
So my question is. What is happening between the done_testing / end of a test and the reporting of the results of the the test harness and what can I do to improve this?
Update: I finally was able to reproduce the issue in a minimal example, and it seems that the problem is not TAP but what happens at the end of the script with a garbage collector or something similar. I create two scripts, first one delete_me.pl:
use strict;
use JSON;
my $huge_json_string = '{';
foreach my $i (0..20000000){
$huge_json_string .= '"key_'.$i.'": "some_value'.$i.'",';
}
$huge_json_string =~ s/,$/}/;#
print "String generated\n";
my $all_to_ram = decode_json($huge_json_string);
print "Hash generated\n";
print( "$0 Run Time: " . ( time - $^T ) . " second(s).\n");
And now I call it from other script delete_me_caller.pl:
use strict;
system("perl delete_me.pl");
print( "$0 Run Time: " . ( time - $^T ) . " second(s).\n");
And here is the surprise:
String generated
Hash generated
delete_me.pl Run Time: 20 second(s).
delete_me_caller.pl Run Time: 42 second(s).
So it takes more time to end the script than to generate the data and load it to memory.
Note: For this script I was using my personal computer with 32GB of ram and i7 8650 U so this may take a lot longer with less RAM or power.
I needed to use "iconv" to convert char encoding from some files generated on windows. Sometimes those files are very big and execution fails because it runs out of RAM. Googling i found a script which is called "iconv-chunks.pl" which is basically a perl script which processes the files and works pretty well, but it generates temporary files on my /tmp folder.
The problem is that this scripts runs automatically everyday for many files and it keeps generating garbage on my /tmp dir even though it has the cleanup flag ON.
The script im talking about is:
https://code.google.com/p/clschool-team4/source/browse/trunk/iconv-chunks.pl?r=53
#!/usr/bin/perl
our $CHUNK_SIZE = 1024 * 1024 * 100; # 100M
=head1 NAME
iconv-chunks - Process huge files with iconv
=head1 SYNOPSIS
iconv-chunks <filename> [iconv-options]
=head1 DESCRIPTION
The standard iconv program reads the entire input file into
memory, which doesn't work for large files (such as database exports).
This script is just a wrapper that processes the input file
in manageable chunks and writes it to standard output.
The first argument is the input filename (use - to specify standard input).
Anything else is passed through to iconv.
The real iconv needs to be somewhere in your PATH.
=head1 EXAMPLES
# Convert latin1 to utf-8:
./iconv-chunks database.txt -f latin1 -t utf-8 > out.txt
# Input filename of - means standard input:
./iconv-chunks - -f iso8859-1 -t utf8 < database.txt > out.txt
# More complex example, using compressed input/output to minimize disk use:
zcat database.txt.gz | ./iconv-chunks - -f iso8859-1 -t utf8 | \
gzip - > database-utf.dump.gz
=head1 AUTHOR
Maurice Aubrey <maurice.aubrey+iconv#gmail.com>
=cut
# $Id: iconv-chunks 6 2007-08-20 21:14:55Z mla $
use strict;
use warnings;
use bytes;
use File::Temp qw/ tempfile /;
# iconv errors:
# iconv: unable to allocate buffer for input: Cannot allocate memory
# iconv: cannot open input file `database.txt': File too large
#ARGV >= 1 or die "Usage: $0 <inputfile> [iconv-options]\n";
my #options = splice #ARGV, 1;
my($oh, $tmp) = tempfile(undef, CLEANUP => 1);
# warn "Tempfile: $tmp\n";
my $iconv = "iconv #options $tmp";
sub iconv { system($iconv) == 0 or die "command '$iconv' failed: $!" }
my $size = 0;
# must read by line to ensure we don't split multi-byte character
while (<>) {
$size += length $_;
print $oh $_;
if ($size >= $CHUNK_SIZE) {
iconv;
truncate $oh, 0 or die "truncate '$tmp' failed: $!";
seek $oh, 0, 0 or die "seek on '$tmp' failed: $!";
$size = 0;
}
}
iconv if $size > 0;
Any help finding the problem or how can it delete temporary files after finishing?
Regards
Change
my($oh, $tmp) = tempfile(undef, CLEANUP => 1);
to
my($oh, $tmp) = tempfile(UNLINK => 1);
CLEANUP is used to trigger removal of temporary directories on exit, not files. Note that passing undef as the first argument in order to use the default template is unnecessary.
Is there a way to turn off flags if they are enabled by default in GetOptions?
This is what I want:
-verbose 0 turns off verbosity
-verbose 1 turns on verbosity
-verbose turns on verbosity
Current code (from Getopt::Long):
use Getopt::Long;
my $data = "file.dat";
my $length = 24;
my $verbose = 1;
GetOptions ("length=i" => \$length, # numeric
"file=s" => \$data, # string
"verbose" => \$verbose) # flag
or die("Error in command line arguments\n");
It's not the way you describe, but the documentation describes "negatable options" designated by an exclamation mark that let you do this:
my $verbose = 1; # default on
GetOptions ('verbose!' => \$verbose);
This allows --verbose (sets it to 1) or --noverbose (sets it to 0).
The Summary of Option Specifications in the documentation for Getopt::Long indicates that you could almost use:
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
my $data = "file.dat";
my $length = 24;
my $verbose = 1;
GetOptions ("length=i" => \$length, # numeric
"file=s" => \$data, # string
"verbose:i" => \$verbose) # optional integer
or die("Error in command line arguments\n");
# Debugging/testing
print "Verbose = $verbose\n";
print "Options:\n";
for my $opt (#ARGV) { print " $opt\n"; }
The : indicates that the value is optional, and the i indicates it takes an integer.
Sample runs (I called the script gol.pl):
$ perl gol.pl
Verbose = 1
Options:
$ perl gol.pl --verbose 0
Verbose = 0
Options:
$ perl gol.pl --verbose=0
Verbose = 0
Options:
$ perl gol.pl --verbose 1
Verbose = 1
Options:
$ perl gol.pl --verbose gooseberry
Verbose = 0
Options:
gooseberry
$ perl gol.pl --verbose
Verbose = 0
Options:
$
There's an 'almost' at the top. As ThisSuitIsBlackNot correctly points out, this sets $verbose to zero when the argument is omitted, which is not what you want.
Your interface is curious. Are you sure you wouldn't be better off with:
--verbose # Enables verbose mode
--noverbose # Disables verbose mode
You can then use "verbose!" to handle that. Also, since verbose mode is enabled by default, there's really no need to support --verbose; there's point in having --verbose 0 to turn it off, or --noverbose, and maybe point in allowing --verbose 9 for extra verbose, etc. You need to think about whether your design is truly appropriate.
This might be a little too complex, but you can use an optional value combined with a custom subroutine:
use strict;
use warnings;
use 5.010;
use Getopt::Long;
sub make_handler {
my $verbose = shift;
return sub {
my ($opt_name, $opt_value) = #_;
die "$opt_name must be 0 or 1" if $opt_value !~ /^(?:0|1)?$/;
if ($opt_value eq '') {
$$verbose = 1;
}
else {
$$verbose = $opt_value;
}
}
}
my $verbose = 1;
my $handler = make_handler(\$verbose);
GetOptions("verbose:s" => $handler) or die "Error in command line arguments";
say $verbose;
Output:
$ ./foo
1
$ ./foo --verbose
1
$ ./foo --verbose 0
0
$ ./foo --verbose 1
1
$ ./foo --verbose bar
verbose must be 0 or 1 at ./foo line 15.
Error in command line arguments at ./foo line 29.
Note that I used a closure to avoid global variables, since Getopt::Long doesn't do anything with the return value of custom subroutines and doesn't allow you to pass in the variable you want to set.
file.pl
if (! getopts('abisf:',\%Options)){
# Display usage details
print "Usage Error invalid options \n";
exit(1);
}
If I run:
$>perl file.pl -q #argv;
This should print the usage error but it doesn't.
$>perl file.pl -a #argv;
This should have $Options{a}=1 but what I see is $Options{a}='' i.e null.
What's going on?
Remember to post an Short, Self-Contained, Correct (Compiling) Example whenever possible; it makes it much easier for people to help you reliably.
Here's an SSCCE:
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Std;
my %Options;
if (! getopts('abisf:',\%Options)){
# Display usage details
print "Usage Error invalid options \n";
exit(1);
}
for my $opt (sort keys %Options)
{
print "-$opt = $Options{$opt}\n";
}
for my $arg (#ARGV)
{
print "arg = $arg\n";
}
print "OK\n";
When the script is called opt.pl and it is invoked as shown below, it seems to work correctly:
$ perl opt.pl
OK
$ perl opt.pl -a
-a = 1
OK
$ perl opt.pl -a x
-a = 1
arg = x
OK
$ perl opt.pl -a -f x
-a = 1
-f = x
OK
$ perl opt.pl -a -f x zzz
-a = 1
-f = x
arg = zzz
OK
$ perl opt.pl -q
Unknown option: q
Usage Error invalid options
$
Do you see anything unexpected in the output? What did you get on your system?
The Perl wrapper below executes commands in parallel, saving STDOUT
and STDERR to /tmp files:
open(A,"|parallel");
for $i ("date", "ls", "pwd", "factor 17") {
print A "$i 1> '/tmp/$i.out' 2> '/tmp/$i.err'\n";
}
close(A);
How do I obtain the exit status values from the individual commands?
To get the exist status of the individual jobs, parallel would need to write the info somewhere. I don't know if it does or not. If it doesn't, you can do that yourself.
my %jobs = (
"date" => "date",
"ls" => "ls",
"pwd" => "pwd",
"factor" => "factor 17",
);
open(my $parallel, "|parallel");
for my $id (keys(%jobs)) {
print $parallel
$jobs{$id}
." 1> '/tmp/$id.out'"
." 2> '/tmp/$id.err' ; "
."echo \$?"
." > '/tmp/$id.exit'\n";
}
close($parallel);
my $exit_status = $? >> 8;
if ($exit_status >= 255) {
print("Failed\n");
} else {
printf("%d failed jobs\n", $exit_status);
}
for my $id (keys(%jobs)) {
...grab output and exit code from files...
}
Update:
I went and installed parallel.
It has an option called --joblog {file} which produces a report with exit codes. It accepts - for file name if you want it to output to STDOUT.
Note that parallel doesn't recognise abnormal death by signal, so this is not included in the --joblog report. Using the solution I posted above, a missing .exit file would indicate an abnormal death. (You must make sure it doesn't exist in the first place, though.)
Update:
#Ole Tange mentions that the limitation of --joblog {file} I mentioned above, the lack of logging of death by signal, has been addressed in version 20110722.
GNU Parallel 20110722 has exit val and signal in --joblog:
parallel --joblog /tmp/log false ::: a
cat /tmp/log
Seq Host Starttime Runtime Send Receive Exitval Signal Command
1 : 1311332758 0 0 0 1 0 false a
If you want to avoid the wrapper you could consider:
cat foo | parallel "{} >\$PARALLEL_SEQ.out 2>\$PARALLEL_SEQ.err; echo \$? >\$PARALLEL_SEQ.status"
Version 20110422 or later makes it even shorter:
cat foo | parallel "{} >{#}.out 2>{#}.err; echo \$? >{#}.status"
If your lines do no contain ' then this should work too:
cat foo | parallel "{} >'{}'.out 2>'{}'.err; echo \$? >'{}'.status"
Instead of wrapping parallel, you can use any of the tons of modules available from CPAN providing similar functionality.
For instance:
use Proc::Queue size => 10, qw(run_back);
my #pids;
for $i ("date", "ls", "pwd", "factor 17") {
push #pids, run_back {
open STDOUT, '>', '/tmp/$i.out';
open STDERR, '>', '/tmp/$i.err';
exec $i;
}
}
for (#pids) {
1 while waitfor($_, 0) <= 0;
say "process $_ exit code: ", ($? >> 8);
}