#!/usr/bin/perl # Test try() use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 49; use Log::Report undef, syntax => 'SHORT'; use Carp; # required for tests eval { use POSIX ':locale_h', 'setlocale'; # avoid user's environment setlocale(LC_ALL, 'POSIX'); }; # start a new logger my $text = ''; open my($fh), '>', \$text; dispatcher close => 'default'; dispatcher FILE => 'out', to => $fh, accept => 'ALL'; cmp_ok(length $text, '==', 0, 'created normal file logger'); my $text_l1 = length $text; info "test"; my $text_l2 = length $text; cmp_ok($text_l2, '>', $text_l1); my @l1 = dispatcher 'list'; cmp_ok(scalar(@l1), '==', 1); is($l1[0]->name, 'out'); try { my @l2 = dispatcher 'list'; cmp_ok(scalar(@l2), '==', 1); is($l2[0]->name, 'try', 'only try dispatcher'); error "this is an error" }; my $caught = $@; # be careful with this... Test::More may spoil it. my @l3 = dispatcher 'list'; cmp_ok(scalar(@l3), '==', 1); is($l3[0]->name, 'out', 'original dispatcher restored'); isa_ok($caught, 'Log::Report::Dispatcher::Try'); ok($caught->failed); ok($caught ? 1 : 0); my @r1 = $caught->exceptions; cmp_ok(scalar(@r1), '==', 1); isa_ok($r1[0], 'Log::Report::Exception'); my @r2 = $caught->wasFatal; cmp_ok(scalar(@r2), '==', 1); isa_ok($r2[0], 'Log::Report::Exception'); try { info "nothing wrong"; trace "trace more" } # no comma! mode => 'DEBUG'; $caught = $@; isa_ok($caught, 'Log::Report::Dispatcher::Try'); ok($caught->success); ok($caught ? 0 : 1); my @r3 = $caught->wasFatal; cmp_ok(scalar(@r3), '==', 0); my @r4 = $caught->exceptions; cmp_ok(scalar(@r4), '==', 2); isa_ok($r4[0], 'Log::Report::Exception'); is($r4[0]->toString, "info: nothing wrong\n"); is("$r4[0]", "info: nothing wrong\n"); isa_ok($r4[1], 'Log::Report::Exception'); is($r4[1]->toString, "trace: trace more\n"); is("$r4[1]", "trace: trace more\n"); $caught->reportAll; # pass on errors my $text_l3 = length $text; cmp_ok($text_l3, '>', $text_l2, 'passed on loggings'); is(substr($text, $text_l2), <<__EXTRA); info: nothing wrong trace: trace more __EXTRA eval { try { try { failure "oops! no network" }; $@->reportAll; }; $@->reportAll; }; like($@, qr[^failure: oops]i); ### context my $context; my $scalar = try { $context = !wantarray && defined wantarray ? 'SCALAR' : 'OTHER'; my @x = 1..10; @x; }; is($context, 'SCALAR', 'try in SCALAR context'); cmp_ok($scalar, '==', 10); try { $context = !defined wantarray ? 'VOID' : 'OTHER'; 3; }; is($context, 'VOID', 'try in VOID context'); my @list = try { $context = wantarray ? 'LIST' : 'OTHER'; 1..5; }; is($context, 'LIST', 'try in LIST context'); cmp_ok(scalar @list, '==', 5); ### convert die/croak/confess # conversions by Log::Report::Die, see t/*die.t my $die = try { die "oops" }; ok(ref $@, 'caught die'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $die_ex = $@->wasFatal; isa_ok($die_ex, 'Log::Report::Exception'); is($die_ex->reason, 'ERROR'); like("$@", qr[^try-block stopped with ERROR: oops at t/54try\.t line \d+$] ); my $croak = try { croak "oops" }; ok(ref $@, 'caught croak'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $croak_ex = $@->wasFatal; isa_ok($croak_ex, 'Log::Report::Exception'); is($croak_ex->reason, 'ERROR'); like("$@", qr[^try-block stopped with ERROR: oops at lib/Log/Report.pm line \d+$] ); my $confess = try { confess "oops" }; ok(ref $@, 'caught confess'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $confess_ex = $@->wasFatal; isa_ok($confess_ex, 'Log::Report::Exception'); is($confess_ex->reason, 'PANIC'); like("$@", qr[^try-block stopped with PANIC: oops at t/54try\.t line \d+$] );