summaryrefslogtreecommitdiff
path: root/t/proxy-with-stack-trace.t
diff options
context:
space:
mode:
Diffstat (limited to 't/proxy-with-stack-trace.t')
-rw-r--r--t/proxy-with-stack-trace.t474
1 files changed, 390 insertions, 84 deletions
diff --git a/t/proxy-with-stack-trace.t b/t/proxy-with-stack-trace.t
index 3f69917..4d49b63 100644
--- a/t/proxy-with-stack-trace.t
+++ b/t/proxy-with-stack-trace.t
@@ -2,138 +2,444 @@
use strict;
use warnings;
use Test::More;
+use List::Util qw( any );
use Log::Any;
-
-plan tests => 48;
+use Scalar::Util qw( blessed );
+use Storable qw( dclone );
use FindBin;
use lib $FindBin::RealBin;
use TestAdapters;
+my (
+ $num_tests,
+ $have_Mojo_Exception,
+ $have_Moose_Exception,
+ $have_Throwable_Error,
+);
BEGIN {
+
+ $num_tests = 152;
+ eval {
+ require Mojo::Exception;
+ $have_Mojo_Exception = 1;
+ $num_tests += 27;
+ };
+ eval {
+ require Throwable::Error;
+ $have_Throwable_Error = 1;
+ $num_tests += 31;
+ };
+ eval {
+ require Moose::Exception;
+ $have_Moose_Exception = 1;
+ $num_tests += 31;
+ };
+
eval {
require Devel::StackTrace;
Devel::StackTrace->VERSION( 2.00 );
};
if ( $@ ) {
plan skip_all => 'Devel::StackTrace >= 2.00 is required for this test';
- }
- else {
- eval {
- require Storable;
- Storable->VERSION( 3.08 );
- };
- if ( $@ ) {
- plan skip_all => 'Storable >= 3.08 is required for this test';
- }
+ $num_tests = 0;
}
}
+plan tests => $num_tests if $num_tests;
+
use Log::Any::Proxy::WithStackTrace; # necessary?
-my $default_log = Log::Any->get_logger;
-my $log = Log::Any->get_logger( proxy_class => 'WithStackTrace' );
+my $default_log = Log::Any->get_logger;
+my $log = Log::Any->get_logger( proxy_class => 'WithStackTrace' );
+my $log_show_args = Log::Any->get_logger( proxy_class => 'WithStackTrace', proxy_show_stack_trace_args => 1);
-is ref $default_log, 'Log::Any::Proxy::Null',
+is ref $default_log, 'Log::Any::Proxy::Null',
'no adapter default proxy is Null';
-is ref $log, 'Log::Any::Proxy::WithStackTrace',
+is ref $log, 'Log::Any::Proxy::WithStackTrace',
'no adapter explicit proxy is WithStackTrace';
+is ref $log_show_args, 'Log::Any::Proxy::WithStackTrace',
+ 'no adapter explicit proxy with proxy_show_stack_trace_args flag is WithStackTrace';
-$default_log->info("test");
-$log ->info("test");
+$default_log ->info("test");
+$log ->info("test");
+$log_show_args->info("test");
-is ref $default_log, 'Log::Any::Proxy::Null',
+is ref $default_log, 'Log::Any::Proxy::Null',
'no adapter default proxy is still Null after logging';
-is ref $log, 'Log::Any::Proxy::WithStackTrace',
+is ref $log, 'Log::Any::Proxy::WithStackTrace',
'no adapter explicit proxy is still WithStackTrace after logging';
+is ref $log_show_args, 'Log::Any::Proxy::WithStackTrace',
+ 'no adapter explicit proxy with proxy_show_stack_trace_args flag is still WithStackTrace after logging';
Log::Any->set_adapter('+TestAdapters::Structured');
-is ref $default_log, 'Log::Any::Proxy',
+is ref $default_log, 'Log::Any::Proxy',
'existing default proxy is reblessed after adapter';
-is ref $log, 'Log::Any::Proxy::WithStackTrace',
+is !!$default_log->{proxy_show_stack_trace_args}, '',
+ 'Defauly log does not proxy_show_stack_trace_args';
+is ref $log, 'Log::Any::Proxy::WithStackTrace',
'existing explicit proxy is still WithStackTrace after adapter';
+is !!$log->{proxy_show_stack_trace_args}, '',
+ 'WithStackTrace does not proxy_show_stack_trace_args';
+is ref $log_show_args, 'Log::Any::Proxy::WithStackTrace',
+ 'existing explicit proxy with proxy_show_stack_trace_args flag is still WithStackTrace after adapter';
+is !!$log_show_args->{proxy_show_stack_trace_args}, 1,
+ 'WithStackTrace does proxy_show_stack_trace_args';
-is ref $default_log->adapter, 'TestAdapters::Structured',
+is ref $default_log->adapter, 'TestAdapters::Structured',
'existing default proxy has correct adapter';
-is ref $log->adapter, 'TestAdapters::Structured',
+is ref $log->adapter, 'TestAdapters::Structured',
'existing explicit proxy has correct adapter';
+is ref $log_show_args->adapter, 'TestAdapters::Structured',
+ 'existing explicit proxy with proxy_show_stack_trace_args flag has correct adapter';
+
+###################################################################
+
+# Dummy default for initial call:
+my $logger = $default_log;
+my $message = "dummy";
+my $extra_args = [];
+
+my ($Mojo_Exception, $Moose_Exception, $Throwable_Error);
+
+sub foo
+{
+ sub bar {
+
+ # Log with a stack trace that is 3 frames deep (main->foo->bar):
+ $logger->info($message, @$extra_args);
+
+ # Create a Mojo::Exception with a similar stack trace:
+ if ($have_Mojo_Exception && !$Mojo_Exception) {
+ local $@;
+ eval { Mojo::Exception->throw("Help!") };
+ $Mojo_Exception = $@;
+ }
+
+ # Create a Moose::Exception with a similar stack trace:
+ if ($have_Moose_Exception && !$Moose_Exception) {
+ $Moose_Exception = Moose::Exception->new(message => "Help!");
+ }
+
+ # Create a Throwable::Error with a similar stack trace:
+ if ($have_Throwable_Error && !$Throwable_Error) {
+ local $@;
+ eval { Throwable::Error->throw("Help!") };
+ $Throwable_Error = $@;
+ # Default log adapter doesn't like coderefs:
+ $Throwable_Error->stack_trace->{frame_filter} = undef;
+ $Throwable_Error->{stack_trace_args} = undef;
+ }
+ }
+
+ bar("quux");
+}
+
+# Make sure exception objects get initialized:
+foo("bar", "baz") if $have_Mojo_Exception ||
+ $have_Moose_Exception ||
+ $have_Throwable_Error;
-my @test_cases = (
+my ($desc, $expected_by_type);
+
+foreach my $t (
[
- 'simple',
- [ 'test' ],
- 'test',
+ "with string",
+ "Help!",
+ [],
+ {
+ "default log" => "Help!",
+ "proxy log" => [
+ "Help!",
+ "Log::Any::MessageWithStackTrace",
+ ],
+ "proxy log show args" => [
+ "Help!",
+ "Log::Any::MessageWithStackTrace",
+ ],
+ },
],
[
- 'with structured data',
- [ 'test', { foo => 1 } ],
- 'test',
+ "with string and extra args",
+ "Help!",
+ [ {extra => "data"} ],
+ {
+ "default log" => "Help!",
+ "proxy log" => [
+ "Help!",
+ "Log::Any::MessageWithStackTrace",
+ ],
+ "proxy log show args" => [
+ "Help!",
+ "Log::Any::MessageWithStackTrace",
+ ],
+ },
],
[
- 'formatted',
- [ 'test %s', 'extra' ],
- 'test extra',
+ "with string and bad extra args",
+ "Help!",
+ [ {extra => "data"}, "huh?" ],
+ {
+ "default log" => "Help!",
+ # no automatic object inflation if unexpected args:
+ "proxy log" => "Help!",
+ "proxy log show args" => "Help!",
+ },
],
-);
-
-sub check_test_cases {
- foreach my $test_case (@test_cases) {
- my ($desc, $args, $expected) = @$test_case;
+ [
+ "with string and bad non-hashref extra args",
+ "Help!",
+ [ "huh?" ],
+ {
+ "default log" => "Help!",
+ # no automatic object inflation if unexpected args:
+ "proxy log" => "Help!",
+ "proxy log show args" => "Help!",
+ },
+ ],
+ [
+ "with non-string unblessed message",
+ {foo => "bar"},
+ [],
+ {
+ "default log" => [
+ {foo => "bar"},
+ "HASH",
+ ],
+ # no automatic object inflation if non-string message:
+ "proxy log" => [
+ {foo => "bar"},
+ "HASH",
+ ],
+ "proxy log show args" => [
+ {foo => "bar"},
+ "HASH",
+ ],
+ },
+ ],
+ [
+ "with dummy blessed object",
+ bless({foo => "bar"}, "DummyError"),
+ [],
+ {
+ "default log" => [
+ qr{^DummyError=HASH\(0x[0-9a-f]+\)},
+ "DummyError",
+ ],
+ # no automatic object inflation if random blessed message:
+ "proxy log" => [
+ qr{^DummyError=HASH\(0x[0-9a-f]+\)},
+ "DummyError",
+ ],
+ "proxy log show args" => [
+ qr{^DummyError=HASH\(0x[0-9a-f]+\)},
+ "DummyError",
+ ],
+ },
+ ],
+ [
+ "with Mojo::Exception message",
+ $Mojo_Exception,
+ [],
+ {
+ "default log" => [
+ qr{^Help! at t/proxy-with-stack-trace\.t line \d+\.},
+ "Mojo::Exception",
+ ],
+ "proxy log" => [
+ qr{^Help! at t/proxy-with-stack-trace\.t line \d+\.},
+ "Mojo::Exception",
+ ],
+ "proxy log show args" => [
+ qr{^Help! at t/proxy-with-stack-trace\.t line \d+\.},
+ "Mojo::Exception",
+ ],
+ },
+ ],
+ [
+ "with Moose::Exception message",
+ $Moose_Exception,
+ [],
+ {
+ "default log" => [
+ qr{^Help! at t/proxy-with-stack-trace\.t line \d+\n},
+ "Moose::Exception",
+ ],
+ "proxy log" => [
+ qr{^Help! at t/proxy-with-stack-trace\.t line \d+\n},
+ "Moose::Exception",
+ ],
+ "proxy log show args" => [
+ qr{^Help! at t/proxy-with-stack-trace\.t line \d+\n},
+ "Moose::Exception",
+ ],
+ },
+ ],
+ [
+ "with Throwable::Error message",
+ $Throwable_Error,
+ [],
+ {
+ "default log" => [
+ qr{^Help!\n\nTrace begun at t/proxy-with-stack-trace\.t line \d+\n},
+ "Throwable::Error",
+ ],
+ "proxy log" => [
+ qr{^Help!\n\nTrace begun at t/proxy-with-stack-trace\.t line \d+\n},
+ "Throwable::Error",
+ ],
+ "proxy log show args" => [
+ qr{^Help!\n\nTrace begun at t/proxy-with-stack-trace\.t line \d+\n},
+ "Throwable::Error",
+ ],
+ },
+ ],
+) {
+ my $orig_message;
+ ($desc, $orig_message, $extra_args, $expected_by_type) = @$t;
- my $is_formatted = $args->[0] =~ /%/;
+ # This can happen if one of the optional exception modules is not
+ # loaded:
+ next unless $orig_message;
- my $method = $is_formatted ? 'infof' : 'info';
+ foreach my $type (sort keys %$expected_by_type) {
- my ($msgs, $msg);
+ $message = ref $orig_message ? dclone $orig_message : $orig_message;
- my $type = 'default';
+ $logger = {
+ "default log" => $default_log,
+ "proxy log" => $log,
+ "proxy log show args" => $log_show_args,
+ }->{$type};
@TestAdapters::STRUCTURED_LOG = ();
- $default_log->$method(@$args);
- $msgs = \@TestAdapters::STRUCTURED_LOG;
- is @$msgs, 1, "$desc expected number of structured messages from $type logger";
- is $msgs->[0]->{category}, 'main',
- "$desc expected category from $type logger";
- is $msgs->[0]->{level}, 'info',
- "$desc expected level from $type logger";
- $msg = $msgs->[0]->{messages}->[0]; # "messages" for text
- is $msg, $expected,
- "$desc expected message from $type logger";
-
- $type = 'stack trace';
+ foo("bar", "baz");
- @TestAdapters::STRUCTURED_LOG = ();
- $log->$method(@$args);
- $msgs = \@TestAdapters::STRUCTURED_LOG;
- is @$msgs, 1, "$desc expected number of structured messages from $type logger";
- is $msgs->[0]->{category}, 'main',
- "$desc expected category from $type logger";
- is $msgs->[0]->{level}, 'info',
- "$desc expected level from $type logger";
- $msg = $msgs->[0]->{data}->[0]; # "data" for non-text
- is ref $msg, 'Log::Any::MessageWithStackTrace',
- "$desc expected message object from $type logger";
- is "$msg", $expected,
- "$desc expected stringified message from $type logger";
- my $trace = $msg->stack_trace;
- is ref $trace, 'Devel::StackTrace',
- "$desc expected stack_trace object from $type logger";
- is $trace->frame_count, 2,
- "$desc stack_trace object has expected number of frames from $type logger";
- # first frame should be the call to "info" inside this sub (19 lines up),
- # second frame should be the call to this sub from main
- is $trace->frame(0)->line, __LINE__ - 19,
- "$desc stack_trace object has expected first frame from $type logger";
- is $trace->frame(1)->subroutine, 'main::check_test_cases',
- "$desc stack_trace object has expected second frame from $type logger";
- if (!$is_formatted && @$args > 1) {
- my $more_data = $msgs->[0]->{data}->[1];
- is_deeply $more_data, $args->[1],
- "expected structured data from $type logger";
+ my $logged = \@TestAdapters::STRUCTURED_LOG;
+
+ my $long_desc = "$type $desc";
+
+ is @$logged, 1,
+ "$long_desc - got expected number of log messages";
+ my $msg = $logged->[0];
+ is $msg->{category}, 'main',
+ "$long_desc - got expected category";
+ is $msg->{level}, 'info',
+ "$long_desc - got expected level";
+
+ my $expected = $expected_by_type->{$type};
+
+ if (ref $expected) {
+ my $messages = $msg->{messages};
+ is $messages, undef,
+ "$long_desc - got expected number of structured messages";
+ my $data = $msg->{data};
+ if (@$extra_args == 0) {
+ is @$data, 1,
+ "$long_desc - got expected number of structured data";
+ }
+ elsif (@$extra_args == 1 && ref $extra_args->[0] eq 'HASH') {
+ is @$data, 2,
+ "$long_desc - got expected number of structured data";
+ is_deeply $data->[1], $extra_args->[0],
+ "$long_desc - got expected extra structured data";
+ }
+ else {
+ is $data, undef,
+ "$long_desc - got expected number of structured data";
+ }
+ my $thing = $data->[0];
+ my $blessed = blessed $thing;
+
+ my $expected_value = $expected->[0];
+ my $expected_type = $expected->[1];
+
+ if ($blessed || ! ref $expected_value) {
+
+ if (ref $expected_value eq 'Regexp') {
+ like "$thing", $expected_value,
+ "$long_desc - message stringifies correctly";
+ }
+ else {
+ is "$thing", $expected_value,
+ "$long_desc - message stringifies correctly";
+ }
+ }
+ is ref $thing, $expected_type,
+ "$long_desc - expected type of structured data got logged";
+
+ my (@frames, $stack_trace);
+ if ($blessed) {
+ @frames = $thing->can("frames") ? $thing->frames : ();
+ unless (@frames) {
+ $stack_trace = $thing->can("stack_trace")
+ ? $thing->stack_trace
+ : $thing->can("trace")
+ ? $thing->trace : undef;
+ @frames = $stack_trace->frames if $stack_trace;
+ }
+ }
+ if (@frames) {
+
+ # Mojo::Exception returns a listref istead of a list:
+ @frames = @{$frames[0]} if @frames == 1 &&
+ ref $frames[0] eq 'ARRAY';
+
+ my $frame = $frames[-1];
+ my $sub = $expected_type eq "Mojo::Exception"
+ ? $frame->[3] : $frame->subroutine;
+ is $sub, "main::foo",
+ "$long_desc - first frame has correct sub";
+ unless ($expected_type eq "Mojo::Exception") {
+ if ($type eq "proxy log") {
+ is_deeply [$frame->args], [],
+ "$long_desc - first frame has expected args";
+ }
+ elsif ($type eq "proxy log show args") {
+ is_deeply [$frame->args], ["bar","baz"],
+ "$long_desc - first frame has expected args";
+ }
+ }
+ $frame = $frames[-2];
+ $sub = $expected_type eq "Mojo::Exception"
+ ? $frame->[3] : $frame->subroutine;
+ is $sub, "main::bar",
+ "$long_desc - second frame has correct sub";
+ unless ($expected_type eq "Mojo::Exception") {
+ if ($type eq "proxy log") {
+ is_deeply [$frame->args], [],
+ "$long_desc - second frame has expected args";
+ }
+ elsif ($type eq "proxy log show args") {
+ is_deeply [$frame->args], ["quux"],
+ "$long_desc - second frame has expected args";
+ }
+ }
+ }
+ }
+ else {
+ my $messages = $msg->{messages};
+ my @expected = ($expected);
+ push @expected, $extra_args->[0] if $extra_args->[0] &&
+ ref $extra_args->[0] ne 'HASH';
+ push @expected, $extra_args->[1] if $extra_args->[1];
+ is @$messages, @expected,
+ "$long_desc - got expected number of structured messages";
+ is_deeply $messages, \@expected,
+ "$long_desc - expected structured message got logged";
+ my $data = $msg->{data};
+ if (ref $extra_args->[0] eq 'HASH') {
+ is @$data, 1,
+ "$long_desc - got expected number of structured data";
+ is_deeply $data->[0], $extra_args->[0],
+ "$long_desc - got expected structured data";
+ }
+ else {
+ is $data, undef,
+ "$long_desc - got expected number of structured data";
+ }
}
}
}
-check_test_cases();
-
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-29 14:52:51 +0000