| Subject: | 024WarnDieCarp.t fails due to hardcoded line numbers |
If Log::Log4perl is packaged to the RPM system through cpan2rpm the
tests in the file 024WarnDieCarp.t fail. This is because the mechanism
in cpan2rpm applied a special patch and inserted the following code at
the beginning of the line:
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if 0; # not running under some shell
This has for effect of shifting the line numbers. Since the test test
the line numbers in some of the assertions the test fails.
I provided here a modified version of the test that doesn't use hard
coded line numbers.
| Subject: | 024WarnDieCarp.t |
#!/usr/bin/perl
# $Id: 024WarnDieCarp.t,v 1.1 2002/08/29 05:33:28 mschilli Exp $
# Check the various logFOO for FOO in {die, warn, Carp*}
# note: I <erik@selberg.com> prefer Test::Simple to just Test.
######################################################################
#
# This is a fairly simply smoketest... it basically runs the gamut of
# the warn / die / croak / cluck / confess / carp family and makes sure
# that the log output contained the appropriate string and STDERR
# contains the appropriate string.
#
######################################################################
use warnings;
use strict;
use Test::More;
use Log::Log4perl qw(get_logger :easy);
use Log::Log4perl::Level;
use File::Spec; use Data::Dumper;
BEGIN {
if ($] < 5.006) {
plan skip_all => "Only with perl >= 5.006";
} else {
plan tests => 62;
}
}
my $warnstr;
# this nullifies warns and dies here... so testing the testscript may suck.
local $SIG{__WARN__} = sub { $warnstr = join("", @_); };
local $SIG{__DIE__} = sub { $warnstr = join("", @_); };
sub warndietest {
my ($method, $in_str, $out_str, $app, $mname) = @_;
eval { &$method($in_str) };
like($warnstr, qr/$out_str/,
"$mname($in_str): STDERR contains \"$out_str\"");
like($app->buffer(), qr/$out_str/,
"$mname($in_str): Buffer contains \"$out_str\"");
$app->buffer("");
}
# same as above, just look for no output
sub warndietest_nooutput {
my ($method, $in_str, $out_str, $app, $mname) = @_;
eval { &$method($in_str) };
unlike($warnstr, qr/$out_str/,
"$mname($in_str): STDERR does NOT contain \"$out_str\"");
unlike($app->buffer(), qr/$out_str/,
"$mname($in_str): Buffer does NOT contain \"$out_str\"");
}
# same as above, just look for no output in buffer, but output in STDERR
sub dietest_nooutput {
my ($method, $in_str, $out_str, $app, $mname) = @_;
eval { &$method($in_str) };
like($warnstr, qr/$out_str/, "$mname($in_str): STDERR contains \"$out_str\"");
unlike($app->buffer(), qr/$out_str/,
"$mname($in_str): Buffer does NOT contain \"$out_str\"");
}
ok(1, "Initialized OK");
############################################################
# Get a logger and use it without having called init() first
############################################################
my $log = Log::Log4perl::get_logger("abc.def");
my $app = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::TestBuffer");
$log->add_appender($app);
######################################################################
# lets start testing!
$log->level($DEBUG);
my $test = 1;
######################################################################
# sanity: make sure the tests spit out FOO to the buffer and STDERR
foreach my $f ("logwarn", "logdie", "logcarp", "logcroak", "logcluck",
"logconfess", "error_warn", "error_die") {
warndietest(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
######################################################################
# change the log level to ERROR... warns should produce nothing now
$log->level($ERROR);
foreach my $f ("logdie", "logcroak",
"logconfess", "error_warn", "error_die") {
warndietest(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
foreach my $f ("logwarn", "logcarp", "logcluck",
) {
warndietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
######################################################################
# change logging to OFF... FATALs still produce output though.
$log->level($OFF); # $OFF == $FATAL... although I suspect thats a bug in the log4j spec
foreach my $f ("logwarn", "logcarp", "logcluck", "error_warn") {
warndietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
foreach my $f ("error_die", "logdie", "logcroak", "logconfess") {
dietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
######################################################################
# Check if logdie %F%L lists the right file/line
######################################################################
Log::Log4perl->init(\<<'EOT');
log4perl.rootLogger=DEBUG, A1
log4perl.appender.A1=Log::Log4perl::Appender::TestBuffer
log4perl.appender.A1.layout=org.apache.log4j.PatternLayout
log4perl.appender.A1.layout.ConversionPattern=%F-%L: %m
EOT
my $logger = get_logger("Twix::Bar");
my $line_number = __LINE__ + 1;
eval { $logger->logdie("Log and die!"); };
my $app0 = Log::Log4perl::Appender::TestBuffer->by_name("A1");
# print "Buffer: ", $app0->buffer(), "\n";
like($app0->buffer(), qr/024WarnDieCarp.t-$line_number: Log and die!/,
"%F-%L adjustment");
######################################################################
# Check if logcarp/cluck/croak are reporting the calling package,
# not the one the error happened in.
######################################################################
$app0->buffer("");
package Weirdo;
our $foo_line;
our $bar_line;
use Log::Log4perl qw(get_logger);
sub foo {
my $logger = get_logger("Twix::Bar");
$foo_line = __LINE__ + 1;
$logger->logcroak("Inferno!");
}
sub bar {
my $logger = get_logger("Twix::Bar");
$bar_line = __LINE__ + 1;
$logger->logdie("Inferno!");
}
package main;
eval { Weirdo::foo(); };
like($app0->buffer(), qr/$Weirdo::foo_line/,
"Check logcroak/Carp");
$app0->buffer("");
eval { Weirdo::bar(); };
like($app0->buffer(), qr/$Weirdo::bar_line/,
"Check logdie");
######################################################################
# Check if logcarp/cluck/croak are reporting the calling package,
# when they are more than one hierarchy from the top.
######################################################################
$app0->buffer("");
package Foo;
our $foo_line;
use Log::Log4perl qw(get_logger);
sub foo {
my $logger = get_logger("Twix::Bar");
$foo_line = __LINE__ + 1;
$logger->logcarp("Inferno!");
}
package Bar;
sub bar {
Foo::foo();
}
package main;
eval { Bar::bar(); };
SKIP: {
use Carp;
skip "Detected buggy Carp.pm (upgrade to perl-5.8.*)", 1 unless
defined $Carp::VERSION;
like($app0->buffer(), qr/$Foo::foo_line/,
"Check logcarp");
}
######################################################################
# Test fix of bug that had logwarn/die/etc print unformatted messages.
######################################################################
$logger = get_logger("Twix::Bar");
$log->level($DEBUG);
eval { $logger->logdie(sub { "a" . "-" . "b" }); };
like($@, qr/a-b/, "bugfix: logdie with sub{} as argument");
$logger->logwarn(sub { "a" . "-" . "b" });
like($warnstr, qr/a-b/, "bugfix: logwarn with sub{} as argument");
$logger->logwarn({ filter => \&Dumper,
value => "a-b" });
like($warnstr, qr/a-b/, "bugfix: logwarn with sub{filter/value} as argument");
eval { $logger->logcroak({ filter => \&Dumper,
value => "a-b" }); };
like($warnstr, qr/a-b/, "bugfix: logcroak with sub{} as argument");
######################################################################
# logcroak/cluck/carp/confess level test
######################################################################
our($carp_line, $call_line);
package Foo1;
use Log::Log4perl qw(:easy);
sub foo { get_logger("Twix::Bar")->logcarp("foocarp"); $carp_line = __LINE__ }
package Bar1;
sub bar { Foo1::foo(); $call_line = __LINE__; }
package main;
my $l4p_app = $Log::Log4perl::Logger::APPENDER_BY_NAME{"A1"};
my $layout = Log::Log4perl::Layout::PatternLayout->new("%M#%L %m%n");
$l4p_app->layout($layout);
$app0->buffer("");
Foo1::foo(); $call_line = __LINE__;
# Foo1::foo#238 foocarp at 024WarnDieCarp.t line 250
like($app0->buffer(), qr/Foo1::foo#$carp_line foocarp.*$call_line/,
"carp in subfunction");
# foocarp at 024WarnDieCarp.t line 250
like($warnstr, qr/foocarp.*line $call_line/, "carp output");
$app0->buffer("");
Bar1::bar();
SKIP: {
use Carp;
skip "Detected buggy Carp.pm (upgrade to perl-5.8.*)", 1 unless
defined $Carp::VERSION;
# Foo1::foo#238 foocarp at 024WarnDieCarp.t line 250
like($app0->buffer(), qr/Foo1::foo#$carp_line foocarp.*$call_line/,
"carp in sub-sub-function");
}
# foocarp at 024WarnDieCarp.t line 250
like($warnstr, qr/foocarp.*line $call_line/, "carp output");
######################################################################
# logconfess fix (1.12)
######################################################################
$app0->buffer("");
package Foo1;
sub new {
my($class) = @_;
bless {}, $class;
}
sub foo1 {
my $log = get_logger();
$log->logconfess("bah!");
}
package main;
my $foo = Foo1->new();
eval { $foo->foo1() };
like $@, qr/024WarnDieCarp.*Foo1::foo1.*eval/s, "Confess logs correct frame";