From 36c339c0798400cb4ac8a5e46fbdb115c57ccf6e Mon Sep 17 00:00:00 2001 From: stdweird Date: Fri, 10 Nov 2017 22:35:41 +0100 Subject: [PATCH 1/2] Move some LC::Exception related common methods from CAF::Path to new CAF::Exception --- src/main/perl/Exception.pm | 186 +++++++++++++++ src/main/perl/Path.pm | 166 +------------ src/test/perl/exception.t | 208 ++++++++++++++++ src/test/perl/modules/exception_helper.pm | 90 +++++++ src/test/perl/path.t | 279 +++++----------------- 5 files changed, 559 insertions(+), 370 deletions(-) create mode 100755 src/main/perl/Exception.pm create mode 100644 src/test/perl/exception.t create mode 100644 src/test/perl/modules/exception_helper.pm diff --git a/src/main/perl/Exception.pm b/src/main/perl/Exception.pm new file mode 100755 index 00000000..72c015d5 --- /dev/null +++ b/src/main/perl/Exception.pm @@ -0,0 +1,186 @@ +#${PMpre} CAF::Exception${PMpost} + +use CAF::Object qw(SUCCESS); + +=pod + +=head1 NAME + +CAF::Exception - provides basic methods for failure and exception handling + +=head2 Private methods + +=over + +=item _get_noaction + +Return NoAction setting: + +=over + +=item Return 0 is C is true + +Any other value of C is ignored. (In particular, +you cannot use C to enable NoAction). + +=item Return value of C method (when defined) + +=item C otherwise + +=back + +Supports an optional C that is prefixed to reporter. + + +=cut + +# TODO: move (again) somewhere else +# this has nothing to do with exceptions, but cannot be in CAF::Object +sub _get_noaction +{ + my ($self, $keeps_state, $msg) = @_; + + $msg = '' if (! defined($msg)); + + my $noaction; + + if ($keeps_state) { + $self->debug(1, $msg, "keeps_state set, noaction is false"); + $noaction = 0; + } else { + if ($self->can('noAction')) { + $noaction = $self->noAction(); + } + + $noaction = $CAF::Object::NoAction if ! defined($noaction); + + $self->debug(1, $msg, "noaction is ", ($noaction ? 'true' : 'false')); + } + + return $noaction ? 1 : 0; +} + +=item _reset_exception_fail + +Reset previous fail attribute and/or exception. + +C is a suffix when reporting the old C attribute +and/or exception error (with debug level 1). + +C is a C instance that is checked for an +existing error, which is set to ignore if it exists. + +Always returns SUCCESS. + +=cut + +sub _reset_exception_fail +{ + my ($self, $msg, $EC) = @_; + + $msg = defined($msg) ? " ($msg)" : ""; + + # Reset the fail attribute + if ($self->{fail}) { + $self->debug(1, "Ignoring/resetting previous existing fail$msg: ", + $self->{fail}); + $self->{fail} = undef; + } + + # Ignore/reset any existing errors + if ($EC->error()) { + # LC::Exception supports formatted stringification + my $errmsg = ''.$EC->error(); + $self->debug(1, "Ignoring/resetting previous existing error$msg: $errmsg"); + $EC->ignore_error(); + }; + + return SUCCESS; +} + + +=item _function_catch + +Execute function reference C with arrayref C<$args> and hashref C<$opts>. + +Method resets any existing fail attribute and error from C instance C. + +When an exception thrown is thrown, it is catched and reset. No error is reported +and undef is returned in this case and the fail attribute is set with the exception +error text. + +=cut + +sub _function_catch +{ + my ($self, $funcref, $args, $opts, $EC) = @_; + + $self->_reset_exception_fail('_function_catch', $EC); + + my $res = $funcref->(@$args, %$opts); + + if ($EC->error()) { + # LC::Exception supports formatted stringification + my $errmsg = ''.$EC->error(); + $EC->ignore_error(); + return $self->fail($errmsg); + } + + return $res; +} + +=item _safe_eval + +Run function reference C with arrayref C and hashref C. + +Return and set fail attribute with C (C<$@> is added when set) on die +or in case of an error (C returned by C). +In case of success, report C (stringified result is added unless C attribute is set) +at verbose level. + +Note that C<_safe_eval> doesn't work with functions +that don't return a defined value when they succeed. + +Resets previous fail attribute and or exceptions (via the C instance C). + +=cut + +sub _safe_eval +{ + my ($self, $funcref, $argsref, $optsref, $failmsg, $msg, $EC) = @_; + + $self->_reset_exception_fail('_safe_eval', $EC); + + my (@args, %opts); + @args = @$argsref if $argsref; + %opts = %$optsref if $optsref; + + local $@; + my $res = eval { + $funcref->(@args, %opts); + }; + + # $res is undef if there is a syntax or runtime error or if the evaluated + # function returns undef (interpreted as a function error). + if ( defined($res) ) { + $self->verbose("$msg: ", ($self->{sensitive} ? "" : "$res")); + } else { + my $err_msg = ''; + if ($@) { + chomp($@); + $err_msg = ": $@"; + } + return $self->fail("$failmsg$err_msg"); + } + + return $res; +} + + +=pod + +=back + +=cut + +1; diff --git a/src/main/perl/Path.pm b/src/main/perl/Path.pm index 35fbe27b..0d0e9794 100644 --- a/src/main/perl/Path.pm +++ b/src/main/perl/Path.pm @@ -1,5 +1,7 @@ #${PMpre} CAF::Path${PMpost} +use parent qw(CAF::Exception); + use CAF::Object qw(SUCCESS CHANGED); use LC::Check 1.22; use LC::Exception qw (throw_error); @@ -136,155 +138,6 @@ sub mkcafpath # TODO: do we need some magic to be able to use as regular exported functions # TODO: handle LC::Check _message, should use Reporter instead of print -=item _get_noaction - -Return NoAction setting: - -=over - -=item Return 0 is C is true - -Any other value of C is ignored. (In particular, -you cannot use C to enable NoAction). - -=item Return value of C otherwise. - -=back - -Supports an optional C that is prefixed to reporter. - -=cut - - -sub _get_noaction -{ - my ($self, $keeps_state, $msg) = @_; - - $msg = '' if (! defined($msg)); - - my $noaction; - - if ($keeps_state) { - $self->debug(1, $msg, "keeps_state set, noaction is false"); - $noaction = 0; - } else { - if ($self->can('noAction')) { - $noaction = $self->noAction(); - } else { - $noaction = $CAF::Object::NoAction; - } - $self->debug(1, $msg, "noaction is ", ($noaction ? 'true' : 'false')); - } - - return $noaction ? 1 : 0; -} - -=item _reset_exception_fail - -Reset previous exceptions and/or fail attribute. - -=cut - -# TODO: move to CAF::Object ? - -sub _reset_exception_fail -{ - my ($self, $msg) = @_; - - $msg = defined($msg) ? " ($msg)" : ""; - - # Reset the fail attribute - if ($self->{fail}) { - $self->debug(1, "Ignoring/resetting previous existing fail$msg: ", - $self->{fail}); - $self->{fail} = undef; - } - - # Ignore/reset any existing errors - if ($EC->error()) { - # LC::Exception supports formatted stringification - my $errmsg = ''.$EC->error(); - $self->debug(1, "Ignoring/resetting previous existing error$msg: $errmsg"); - $EC->ignore_error(); - }; - - return SUCCESS; -} - - -=item _function_catch - -Execute function reference C with arrayref C<$args> and hashref C<$opts>. - -Method resets/ignores any existing errors and fail attribute, and catches any exception thrown. -No error is reported, it returns undef in this case and the fail attribute is set. - -=cut - -sub _function_catch -{ - my ($self, $funcref, $args, $opts) = @_; - - $self->_reset_exception_fail('_function_catch'); - - my $res = $funcref->(@$args, %$opts); - - if ($EC->error()) { - # LC::Exception supports formatted stringification - my $errmsg = ''.$EC->error(); - $EC->ignore_error(); - return $self->fail($errmsg); - } - - return $res; -} - -# TODO: move to CAF::Object ? - -=item _safe_eval - -Run function reference C with arrayref C and hashref C. - -Return and set fail attribute with C on die or an error (C returned -by C), or print (at verbose level) C on success (respectively $@ and -stringified result are appended). Note that C<_safe_eval> doesn't work with functions -that don't return a defined value when they succeed. - -Resets previous exceptions and/or fail attribute - -=cut - -sub _safe_eval -{ - my ($self, $funcref, $argsref, $optsref, $failmsg, $msg) = @_; - - $self->_reset_exception_fail('_safe_eval'); - - my (@args, %opts); - @args = @$argsref if $argsref; - %opts = %$optsref if $optsref; - - local $@; - my $res = eval { - $funcref->(@args, %opts); - }; - - # $res is undef if there is a syntax or runtime error or if the evaluated - # function returns undef (interpreted as a function error). - if ( defined($res) ) { - $self->verbose("$msg: $res"); - } else { - my $err_msg = ''; - if ($@) { - chomp($@); - $err_msg = ": $@"; - } - return $self->fail("$failmsg$err_msg"); - } - - return $res; -} - =item LC_Check @@ -317,7 +170,7 @@ sub LC_Check my $funcref = $LC_CHECK_DISPATCH{$function}; if (defined($funcref)) { - return $self->_function_catch($funcref, $args, $opts); + return $self->_function_catch($funcref, $args, $opts, $EC); } else { return $self->fail("Unsupported LC::Check function $function"); }; @@ -452,7 +305,7 @@ sub cleanup $dest = $self->_untaint_path($dest, "cleanup dest") || return; - $self->_reset_exception_fail('cleanup'); + $self->_reset_exception_fail('cleanup', $EC); return SUCCESS if (! $self->any_exists($dest)); @@ -490,6 +343,7 @@ sub cleanup $CLEANUP_DISPATCH{$method}, \@args, undef, "Cleanup $method failed to remove $dest", "Cleanup $method removed $dest", + $EC ); # move and unlink return 0 on failure, set $! # rmtree dies on failure @@ -564,7 +418,7 @@ sub directory # assume we will create a new directory my $newdir = 1; - $self->_reset_exception_fail('directory'); + $self->_reset_exception_fail('directory', $EC); if (delete $opts{temp}) { # pad to at least X by adding 4 @@ -584,6 +438,7 @@ sub directory \&tempdir, [$directory], {CLEANUP => 1}, "Failed to create temporary directory $directory", "Created temporary directory with tempdir", + $EC ); return if defined($self->{fail}); } @@ -640,7 +495,7 @@ sub _make_link $self->debug(2, "Creating $link_type $link_path to target $target"); - $self->_reset_exception_fail($link_type); + $self->_reset_exception_fail($link_type, $EC); my $status = $self->LC_Check('link', [$link_path, $target], \%opts); @@ -863,7 +718,7 @@ sub move $src = $self->_untaint_path($src, "move src") || return; $dest = $self->_untaint_path($dest, "move dest") || return; - $self->_reset_exception_fail('move'); + $self->_reset_exception_fail('move', $EC); return SUCCESS if (! $self->any_exists($src)); @@ -894,6 +749,7 @@ sub move $CLEANUP_DISPATCH{move}, [$src, $dest], undef, "Failed to move $src to $dest", "Moved $src to $dest", + $EC ); # move returns 0 on failure, set $! return $self->fail("Failed to move $src to $dest: $!") if ! $res; @@ -990,7 +846,7 @@ sub listdir $dir = $self->_untaint_path($dir, "listdir directory") || return; $dir =~ s#/*$##; - $self->_reset_exception_fail('listdir'); + $self->_reset_exception_fail('listdir', $EC); if (! $self->directory_exists($dir)) { return $self->fail("listdir: directory $dir is not a directory"); diff --git a/src/test/perl/exception.t b/src/test/perl/exception.t new file mode 100644 index 00000000..5979dab3 --- /dev/null +++ b/src/test/perl/exception.t @@ -0,0 +1,208 @@ +use strict; +use warnings; + +use Test::More; +use Test::MockModule; +use Test::Quattor::Object; +use LC::Exception qw(throw_error); +use CAF::Object; + +use FindBin qw($Bin); +use lib "$Bin/modules"; + +use exception_helper; + +my $mockobj = Test::MockModule->new('CAF::Object'); + + +=pod + +=head1 SYNOPSIS + +Test all methods for C + +=head2 dummy object test package + +=cut + +{ + package test_caf_exception; + use parent qw(CAF::Object CAF::Exception); + #our $EC = LC::Exception::Context->new->will_store_all; + sub _initialize ## no critic (Subroutines::ProhibitNestedSubs) + { + my ($self, %opts) = @_; + foreach my $optname (qw(log NoAction)) { + $self->{$optname} = $opts{$optname} if exists $opts{$optname}; + }; + return CAF::Object::SUCCESS; + }; +} + +# the exception context of this unittest +my $EC = LC::Exception::Context->new->will_store_all; + +# Because we throw an error below from this unittest (ie main package) +# we must have a exception context EC that we can use to reset it +# So setting up and following the EC from the temporary package will not help us +# Normally you don't do things this way, and stuff should be ok. +# There's a support group for people who do not understand LC::Exception +# They're called everyone, they meet at the bar (apologies to GCarlin) +# for convenience +#my $ec = $test_caf_exception::EC; +my $ec = $EC; + +# set the EC in the helper module +set_ec_check($ec); + +my $ec_check = set_ec_check(); +is($ec_check, $ec, "tets_caf_object EC set in helper"); + + +my $logobj = Test::Quattor::Object->new(); +my $tco = test_caf_exception->new(log => $logobj); + +=head2 _get_noaction + +=cut + +ok(!defined $tco->noAction(), "noAction method returns undef"); + +# return defined value (none set during init) +$mockobj->mock('noAction', sub {return 1}); + +$CAF::Object::NoAction = 0; + +ok($tco->_get_noaction(), "_get_noaction returns false with noAction=1 CAF::Object::NoAction=0 and no keeps_state"); +ok($tco->_get_noaction(0), "_get_noaction returns false with noAction=1 CAF::Object::NoAction=0 and keeps_state false"); +ok(! $tco->_get_noaction(1), "_get_noaction returns false with noAction=1 CAF::Object::NoAction=0 and keeps_state true"); + +$CAF::Object::NoAction = 1; + +ok($tco->_get_noaction(), "_get_noaction returns true with noAction=1 CAF::Object::NoAction=1 and no keeps_state"); +ok($tco->_get_noaction(0), "_get_noaction returns true with noAction=1 CAF::Object::NoAction=1 and keeps_state false"); +ok(! $tco->_get_noaction(1), "_get_noaction returns false with noAction=1 CAF::Object::NoAction=1 and keeps_state true"); + +# use original noAction method which returns undef (so global CAF::Object::NoAction is used instead) +$mockobj->unmock('noAction'); + +$CAF::Object::NoAction = 0; + +ok(! $tco->_get_noaction(), "_get_noaction returns false with CAF::Object::NoAction=0 and no keeps_state"); +ok(! $tco->_get_noaction(0), "_get_noaction returns false with CAF::Object::NoAction=0 and keeps_state false"); +ok(! $tco->_get_noaction(1), "_get_noaction returns false with CAF::Object::NoAction=0 and keeps_state true"); + +$CAF::Object::NoAction = 1; + +ok($tco->_get_noaction(), "_get_noaction returns true with CAF::Object::NoAction=1 and no keeps_state"); +ok($tco->_get_noaction(0), "_get_noaction returns true with CAF::Object::NoAction=1 and keeps_state false"); +ok(! $tco->_get_noaction(1), "_get_noaction returns false with CAF::Object::NoAction=1 and keeps_state true"); + +=head2 _reset_exception_fail + +=cut + + +init_exception($tco, "test _reset_exception_fail"); + +ok($tco->_reset_exception_fail(undef, $ec), "_reset_exception_fail returns SUCCESS"); + +# expected_reset is 0 here, because it's not mocked yet +verify_exception($tco, "test _reset_exception_fail", 0, 0); + +# Continue with mocking _reset_exception_fail +mock_reset_exception_fail(); + +=head2 _function_catch + +=cut + +my $args = []; +my $opts = {}; + +my $success_func = sub { + my ($arg1, $arg2, %opts) = @_; + push(@$args, $arg1, $arg2); + while (my ($k, $v) = each %opts) { + $opts->{$k} = $v; + }; + return 100; +}; + +# Empty args and opts refs +$args = []; +$opts = {}; + +init_exception($tco, "_function_catch success"); + +is($tco->_function_catch($success_func, [qw(a b)], {c => 'd', e => 'f'}, $ec), 100, + "_function_catch with success_func returns correct value"); +is_deeply($args, [qw(a b)], "_function_catch passes arg arrayref correctly"); +is_deeply($opts, {c => 'd', e => 'f'}, "_function_catch passes opt hashref correctly"); + +verify_exception($tco, "_function_catch success"); + +# Test failures/exception +# Not going to check args/opts +my $failure_func = sub { + throw_error('failure_func failed', 'no real reason'); + return 200; +}; + +init_exception($tco, "_function_catch fail"); + + +ok(! defined($tco->_function_catch($failure_func, undef, undef, $ec)), + "_function_catch with failure_func returns undef"); + +verify_exception($tco, "_function_catch fail", '\*\*\* failure_func failed: no real reason'); + +=head2 _safe_eval + +=cut + +my $funcref = sub { + my ($ok, %opts) = @_; + if ($ok) { + return "hooray $opts{test}"; + } else { + die "bad day today $opts{test}"; + } +}; + + +my $verbose = []; +$mockobj->mock('verbose', sub {shift; push(@$verbose, \@_);}); + +init_exception($tco, "_safe_eval ok"); + +$verbose = []; +is($tco->_safe_eval($funcref, [1], {test => 123}, "eval fail", "eval ok", $ec), "hooray 123", + "_safe_eval with non-die function returns returnvalue"); +is_deeply($verbose, [['eval ok: ', 'hooray 123']], "_safe_eval reports result verbose"); + +init_exception($tco, "_safe_eval ok pt2"); + +$verbose = []; +$tco->{sensitive} = 1; +is($tco->_safe_eval($funcref, [1], {test => 123}, "eval fail", "eval ok", $ec), "hooray 123", + "_safe_eval with non-die function returns returnvalue pt2"); +is_deeply($verbose, [['eval ok: ', '']], + "_safe_eval does not report result verbose with sensitive=1"); + +verify_exception($tco, "_safe_eval ok"); + +init_exception($tco, "_safe_eval fail"); + +ok(! defined($tco->_safe_eval($funcref, [0], {test => 123}, "eval fail", "eval ok", $ec)), + "_safe_eval with die function returns undef"); + +verify_exception($tco, "_safe_eval fail", '^eval fail: bad day today 123'); + +=pod + +=back + +=cut + +done_testing(); diff --git a/src/test/perl/modules/exception_helper.pm b/src/test/perl/modules/exception_helper.pm new file mode 100644 index 00000000..eefeafad --- /dev/null +++ b/src/test/perl/modules/exception_helper.pm @@ -0,0 +1,90 @@ +package exception_helper; + +use strict; +use warnings; + +use Test::MockModule; +use Test::More; + +use parent qw(Exporter); + +our @EXPORT = qw(init_exception verify_exception mock_reset_exception_fail set_ec_check); + +my $mock = Test::MockModule->new('CAF::Exception'); + +our $exception_reset = 0; +our $symlink_call_count = 0; +our $hardlink_call_count = 0; +our $function_catch_call_count = 0; + +my $ec_check; + + +# Set LC exception instance if arg is defined; return ec_check +sub set_ec_check +{ + my $ec = shift; + $ec_check = $ec if defined($ec); + + return $ec_check; +} + +# init_exception() and verify_exception() functions work in pair. They allow to register a message +# in 'fail' attribute at the beginning of a test section and to verify if new (unexpected) exceptions +# where raised during the test section. To reset the 'fail' attribute after verify_exception(), +# call _reset_exception_fail(). init_exception() implicitely resets the 'fail' attribute and also +# reset to 0 the count of calls to _reset_exception_fail(). +sub init_exception +{ + my ($tco, $msg) = @_; + $exception_reset = 0; + $symlink_call_count = 0; + $hardlink_call_count = 0; + $function_catch_call_count = 0; + + # Set the fail attribute, it should be reset + $tco->{fail} = "origfailure $msg"; + + # Inject an error, _function_catch should handle it gracefully (i.e. ignore it) + my $myerror = LC::Exception->new(); + $myerror->reason("origexception $msg"); + $myerror->is_error(1); + $ec_check->error($myerror); + + ok($ec_check->error(), "Error before $msg"); +} + +sub verify_exception +{ + my ($tco, $msg, $fail, $expected_reset, $noreset) = @_; + $expected_reset = 1 if (! defined($expected_reset)); + is($exception_reset, $expected_reset, "_reset_exception_fail called $expected_reset times after $msg"); + if ($noreset) { + ok($ec_check->error(), "Error not reset after $msg"); + } else { + ok(! $ec_check->error(), "Error reset after $msg"); + }; + if ($noreset && defined($tco->{fail})) { + like($tco->{fail}, qr{^origfailure }, "Fail attribute matches originalfailure on noreset after $msg"); + } elsif ($fail && defined($tco->{fail})) { + like($tco->{fail}, qr{$fail}, "Fail attribute matches $fail after $msg"); + unlike($tco->{fail}, qr{origfailure}, "original fail attribute reset"); + } elsif ( ! $noreset ) { + ok(! defined($tco->{fail}), "Fail attribute reset after $msg"); + } else { + ok(0, "internal test error: unexpected undefined fail attribute") if (! defined($tco->{fail})); + }; +}; + + +sub mock_reset_exception_fail +{ + $mock->mock('_reset_exception_fail', sub { + $exception_reset += 1; + diag "mocked _reset_exception_fail $exception_reset times ".(scalar @_ >= 2 && defined($_[1]) ? $_[1] : ''); + my $init = $mock->original("_reset_exception_fail"); + return &$init(@_); + }); +} + +1; diff --git a/src/test/perl/path.t b/src/test/perl/path.t index b1dce7c9..fac76dc2 100644 --- a/src/test/perl/path.t +++ b/src/test/perl/path.t @@ -26,11 +26,16 @@ use Test::Quattor::Filetools qw(writefile readfile);; use File::Path qw(mkpath rmtree); use File::Basename qw(dirname); -my $ec_check = $CAF::Path::EC; +use exception_helper; + +set_ec_check($CAF::Path::EC); +mock_reset_exception_fail(); + my $obj = Test::Quattor::Object->new(); my $mock = Test::MockModule->new('CAF::Path'); +my $mockexc = Test::MockModule->new('CAF::Exception'); my $mockobj = Test::MockModule->new('CAF::Object'); # return global value instead of the one set during init @@ -45,177 +50,20 @@ my $dirlink = "$basetest/directory_symlink"; my $mc = mypath->new(log => $obj); -=head2 _get_noaction - -=cut - -$CAF::Object::NoAction = 0; - -ok(! $mc->_get_noaction(), "_get_noaction returns false with CAF::Object::NoAction=0 and no keeps_state"); -ok(! $mc->_get_noaction(0), "_get_noaction returns false with CAF::Object::NoAction=0 and keeps_state false"); -ok(! $mc->_get_noaction(1), "_get_noaction returns false with CAF::Object::NoAction=0 and keeps_state true"); - -$CAF::Object::NoAction = 1; - -ok($mc->_get_noaction(), "_get_noaction returns true with CAF::Object::NoAction=1 and no keeps_state"); -ok($mc->_get_noaction(0), "_get_noaction returns true with CAF::Object::NoAction=1 and keeps_state false"); -ok(! $mc->_get_noaction(1), "_get_noaction returns false with CAF::Object::NoAction=1 and keeps_state true"); - -=head2 _reset_exception_fail - -=cut - -my $exception_reset = 0; -my $symlink_call_count = 0; -my $hardlink_call_count = 0; -my $function_catch_call_count = 0; - -# init_exception() and verify_exception() functions work in pair. They allow to register a message -# in 'fail' attribute at the beginning of a test section and to verify if new (unexpected) exceptions -# where raised during the test section. To reset the 'fail' attribute after verify_exception(), -# call _reset_exception_fail(). init_exception() implicitely resets the 'fail' attribute and also -# reset to 0 the count of calls to _reset_exception_fail(). -sub init_exception -{ - my ($msg) = @_; - $exception_reset = 0; - $symlink_call_count = 0; - $hardlink_call_count = 0; - $function_catch_call_count = 0; - - # Set the fail attribute, it should be reset - $mc->{fail} = "origfailure $msg"; - - # Inject an error, _function_catch should handle it gracefully (i.e. ignore it) - my $myerror = LC::Exception->new(); - $myerror->reason("origexception $msg"); - $myerror->is_error(1); - $ec_check->error($myerror); - - ok($ec_check->error(), "Error before $msg"); -} - -sub verify_exception -{ - my ($msg, $fail, $expected_reset, $noreset) = @_; - $expected_reset = 1 if (! defined($expected_reset)); - is($exception_reset, $expected_reset, "_reset_exception_fail called $expected_reset times after $msg"); - if ($noreset) { - ok($ec_check->error(), "Error not reset after $msg"); - } else { - ok(! $ec_check->error(), "Error reset after $msg"); - }; - if ($noreset && defined($mc->{fail})) { - like($mc->{fail}, qr{^origfailure }, "Fail attribute matches originalfailure on noreset after $msg"); - } elsif ($fail && defined($mc->{fail})) { - like($mc->{fail}, qr{$fail}, "Fail attribute matches $fail after $msg"); - unlike($mc->{fail}, qr{origfailure}, "original fail attribute reset"); - } elsif ( ! $noreset ) { - ok(! defined($mc->{fail}), "Fail attribute reset after $msg"); - } else { - ok(0, "internal test error: unexpected undefined fail attribute") if (! defined($mc->{fail})); - }; -}; - -init_exception("test _reset_exception_fail"); - -ok($mc->_reset_exception_fail(), "_reset_exception_fail returns SUCCESS"); - -# expected_reset is 0 here, because it's not mocked yet -verify_exception("test _reset_exception_fail", 0, 0); - -# Continue with mocking _reset_exception_fail -$mock->mock('_reset_exception_fail', sub { - $exception_reset += 1; - diag "mocked _reset_exception_fail $exception_reset times ".(scalar @_ == 2 ? $_[1] : ''); - my $init = $mock->original("_reset_exception_fail"); - return &$init(@_); -}); - # Mocked symlink() and hardlink() to count calls $mock->mock('symlink', sub { - $symlink_call_count += 1; + $exception_helper::symlink_call_count += 1; my $symlink_orig = $mock->original('symlink'); return &$symlink_orig(@_); }); $mock->mock('hardlink', sub { - $hardlink_call_count += 1; + $exception_helper::hardlink_call_count += 1; my $hardlink_orig = $mock->original('hardlink'); return &$hardlink_orig(@_); }); -=head2 _function_catch - -=cut - -my $args = []; -my $opts = {}; - -my $success_func = sub { - my ($arg1, $arg2, %opts) = @_; - push(@$args, $arg1, $arg2); - while (my ($k, $v) = each %opts) { - $opts->{$k} = $v; - }; - return 100; -}; - -# Empty args and opts refs -$args = []; -$opts = {}; - -init_exception("_function_catch success"); - -is($mc->_function_catch($success_func, [qw(a b)], {c => 'd', e => 'f'}), 100, - "_function_catch with success_func returns correct value"); -is_deeply($args, [qw(a b)], "_function_catch passes arg arrayref correctly"); -is_deeply($opts, {c => 'd', e => 'f'}, "_function_catch passes opt hashref correctly"); - -verify_exception("_function_catch success"); - -# Test failures/exception -# Not going to check args/opts -my $failure_func = sub { - throw_error('failure_func failed', 'no real reason'); - return 200; -}; - -init_exception("_function_catch fail"); - -ok(! defined($mc->_function_catch($failure_func)), - "_function_catch with failure_func returns undef"); - -verify_exception("_function_catch fail", '\*\*\* failure_func failed: no real reason'); - -=head2 _safe_eval - -=cut - -my $funcref = sub { - my ($ok, %opts) = @_; - if ($ok) { - return "hooray $opts{test}"; - } else { - die "bad day today $opts{test}"; - } -}; - - -init_exception("_safe_eval ok"); - -is($mc->_safe_eval($funcref, [1], {test => 123}, "eval fail", "eval ok"), "hooray 123", - "_safe_eval with non-die function returns returnvalue"); - -verify_exception("_safe_eval ok"); - -init_exception("_safe_eval fail"); - -ok(! defined($mc->_safe_eval($funcref, [0], {test => 123}, "eval fail", "eval ok")), - "_safe_eval with die function returns undef"); - -verify_exception("_safe_eval fail", '^eval fail: bad day today 123'); =head2 LC_Check @@ -226,19 +74,19 @@ verify_exception("_safe_eval fail", '^eval fail: bad day today 123'); my $noaction_args = []; my $func_catch_args = []; my $fc_val; -$mock->mock('_get_noaction', sub { +$mockexc->mock('_get_noaction', sub { shift; push (@$noaction_args, shift); return 20; # non-sensical value; but clear return value for testing }); -$mock->mock('_function_catch', sub { +$mockexc->mock('_function_catch', sub { my $self = shift; - $self->_reset_exception_fail(); + $self->_reset_exception_fail(undef, $CAF::Path::EC); push(@$func_catch_args, @_); return 100; # more nonsensical stuff but very usefull for testing }); -init_exception("LC_Check mocked directory dispatch"); +init_exception($mc, "LC_Check mocked directory dispatch"); is($mc->LC_Check('directory', [qw(a b c)], {optX => 'x', 'noaction' => 5, 'keeps_state' => 30}), 100, "LC_Check returns value from _func_catch on known LC::Check dispatch"); @@ -246,15 +94,14 @@ is_deeply($noaction_args, [30], "keeps_state option passed to _get_noaction"); is_deeply($func_catch_args, [ \&LC::Check::directory, # coderef to from the dispatch table [qw(a b c)], - {optX => 'x', 'noaction' => 20, silent => 0} # keeps_state is removed; noaction overridden with value from _get_noaction; silent=0 with noaction + {optX => 'x', 'noaction' => 20, silent => 0}, # keeps_state is removed; noaction overridden with value from _get_noaction; silent=0 with noaction + $CAF::Path::EC, ], "_func_args called with expected args"); -verify_exception("LC_Check mocked directory dispatch"); - - +verify_exception($mc, "LC_Check mocked directory dispatch"); # Test calling unknown dispatch method -init_exception("LC_Check unknown dispatch"); +init_exception($mc, "LC_Check unknown dispatch"); $func_catch_args = []; ok(! defined($mc->LC_Check('no_lc_check_function')), # args are not relevant "failing LC_Check returns undef"); @@ -263,17 +110,17 @@ is_deeply($func_catch_args, [], "_func_catch not called"); is($mc->{fail}, "Unsupported LC::Check function no_lc_check_function", "fail attribute set on unknown dispatch failure"); # so no point in running verify_excpetion -is($exception_reset, 0, "exception reset is not called when handling unknown dispatch"); -ok($mc->_reset_exception_fail(), "_reset_exception_fail after unknown dispatch"); +is($exception_helper::exception_reset, 0, "exception reset is not called when handling unknown dispatch"); +ok($mc->_reset_exception_fail(undef, $CAF::Path::EC), "_reset_exception_fail after unknown dispatch"); # Done, unmock _get_noaction and mock _function_catch differently for for further tests -$mock->unmock('_get_noaction'); +$mockexc->unmock('_get_noaction'); # New mocked _function_catch() allow to count the number of calls to computing # the expected number of exception resets -$mock->mock('_function_catch', sub { - $function_catch_call_count += 1; - my $function_catch_orig = $mock->original('_function_catch'); +$mockexc->mock('_function_catch', sub { + $exception_helper::function_catch_call_count += 1; + my $function_catch_orig = $mockexc->original('_function_catch'); return &$function_catch_orig(@_); }); @@ -302,7 +149,7 @@ ok(! defined($mc->{fail}), "no fail attribute set with ok path"); =cut -init_exception("existence tests (file/directory)"); +init_exception($mc, "existence tests (file/directory)"); # Tests without NoAction $CAF::Object::NoAction = 0; @@ -342,8 +189,8 @@ is($mc->is_hardlink($basetestfile, $basetestfile), 0, "is_hardlink false (same f is($mc->is_hardlink($basetestfile, $basetestfile2), 0, "is_hardlink false with non-hardlinked files"); # noreset=1 -verify_exception("existence tests (file/directory)", undef, 0, 1); -ok($mc->_reset_exception_fail(), "_reset_exception_fail after existence tests (file/directory)"); +verify_exception($mc, "existence tests (file/directory)", undef, 0, 1); +ok($mc->_reset_exception_fail(undef, $CAF::Path::EC), "_reset_exception_fail after existence tests (file/directory)"); =head2 symlink/hardlink creation/update/test @@ -377,7 +224,7 @@ sub check_symlink { is(readlink($link_path), $target, $target_msg) unless $noaction; }; -init_exception("symlink tests"); +init_exception($mc, "symlink tests"); rmtree ($basetest) if -d $basetest; my $target_directory = "tgtdir"; @@ -441,15 +288,16 @@ ok($mc->is_symlink($brokenlink), "Broken link has been updated (target check dis is(readlink($brokenlink), "really_really_missing", "Broken link has the expected target by 'check' undefined"); # noreset=0 -diag ("symlink() calls: $symlink_call_count, _function_catch() calls: $function_catch_call_count"); -verify_exception("symlink tests", "Failed to create symlink", $symlink_call_count + $function_catch_call_count, 0); -ok($mc->_reset_exception_fail(), "_reset_exception_fail after symlink tests"); +diag ("symlink() calls: $exception_helper::symlink_call_count, _function_catch() calls: $exception_helper::function_catch_call_count"); +verify_exception($mc, "symlink tests", "Failed to create symlink", + $exception_helper::symlink_call_count + $exception_helper::function_catch_call_count, 0); +ok($mc->_reset_exception_fail(undef, $CAF::Path::EC), "_reset_exception_fail after symlink tests"); # Test xxx_exists, is_hardlink and has_hardlinks methods with symlinks # Needs symlinks created in previous step (symlink creation/update) -init_exception("existence tests (symlinks and hardlinks)"); +init_exception($mc, "existence tests (symlinks and hardlinks)"); my $hardlink = "$basetest/a_hardlink"; ok(! $mc->directory_exists($brokenlink), "directory_exists false on brokenlink"); @@ -479,8 +327,8 @@ is($mc->is_hardlink($filelink, $hardlink), 1, "$filelink and $hardlink are hard is(! $mc->is_hardlink($filelink, $dirlink), 1, "$filelink and $dirlink are not hard linked (different hard links)"); # noreset=0 -verify_exception("existence tests (symlinks and hardlinks)", undef, 6, 0); -ok($mc->_reset_exception_fail(), "_reset_exception_fail after existence tests (symlinks and hardlinks)"); +verify_exception($mc, "existence tests (symlinks and hardlinks)", undef, 6, 0); +ok($mc->_reset_exception_fail(undef, $CAF::Path::EC), "_reset_exception_fail after existence tests (symlinks and hardlinks)"); # Test hardlink creation @@ -511,7 +359,7 @@ sub check_hardlink { ok($mc->is_hardlink($link_path, $target), $target_msg) unless $noaction; }; -init_exception("hardlink tests"); +init_exception($mc, "hardlink tests"); rmtree ($basetest) if -d $basetest; my $cwd = cwd(); @@ -552,9 +400,10 @@ is($mc->hardlink($target_file1, $hardlink2), CHANGED, "hardlink2 created"); is($mc->is_hardlink($hardlink1, $hardlink2), 0, "is_hardlink false (0) with 2 different hardlinks"); # noreset=0 -diag ("hardlink() calls: $hardlink_call_count, _function_catch() calls: $function_catch_call_count"); -verify_exception("hardlink tests", "\\*\\*\\* invalid target", $hardlink_call_count + $function_catch_call_count, 0); -ok($mc->_reset_exception_fail(), "_reset_exception_fail after hardlink tests"); +diag ("hardlink() calls: $exception_helper::hardlink_call_count, _function_catch() calls: $exception_helper::function_catch_call_count"); +verify_exception($mc, "hardlink tests", "\\*\\*\\* invalid target", + $exception_helper::hardlink_call_count + $exception_helper::function_catch_call_count, 0); +ok($mc->_reset_exception_fail(undef, $CAF::Path::EC), "_reset_exception_fail after hardlink tests"); =head2 directory @@ -734,12 +583,12 @@ $CAF::Object::NoAction = 0; rmtree($basetest) if -d $basetest; $testdir = "$basetest/a/b/c"; -init_exception("directory creation NoAction=0"); +init_exception($mc, "directory creation NoAction=0"); verify_directory($testdir, "directory exception test"); # exception reset called 3 times: start, LC_Check and status -verify_exception("directory creation NoAction=0", undef, 3); +verify_exception($mc, "directory creation NoAction=0", undef, 3); rmtree($basetest) if -d $basetest; @@ -753,13 +602,13 @@ ok(symlink("really_really_missing", $brokenlink), "broken symlink created 1"); ok(!$mc->directory_exists($brokenlink), "brokenlink is not a directory"); -init_exception("directory creation failure NoAction=0"); +init_exception($mc, "directory creation failure NoAction=0"); ok(!defined($mc->directory("$brokenlink/exist")), "directory on broken symlink parent returns undef on failure"); # Called 2 times: init and LC_Check (no status) -verify_exception("directory creation failure NoAction=0", +verify_exception($mc, "directory creation failure NoAction=0", '\*\*\* mkdir\(target/test/check/broken_symlink, 0755\): File exists', 2); ok(! $mc->directory_exists("$brokenlink/exist"), "directory brokenlink/exist not created"); ok(! $mc->directory_exists($brokenlink), "brokenlink still not a directory"); @@ -776,12 +625,12 @@ ok(symlink("really_really_missing", $brokenlink), "broken symlink created 2"); ok(!$mc->directory_exists($brokenlink), "brokenlink is not a directory 2"); -init_exception("temp directory creation failure NoAction=0 subdir"); +init_exception($mc, "temp directory creation failure NoAction=0 subdir"); ok(!defined($mc->directory("$brokenlink/sub/exist-X", temp => 1)), "temp directory on broken symlink parent returns undef on failure missing subdir"); # called 3 times: init, 2 times with creation of subdir via failing directory -verify_exception("temp directory creation failure NoAction=0 subdir", +verify_exception($mc, "temp directory creation failure NoAction=0 subdir", 'Failed to create basedir for temporary directory target/test/check/broken_symlink/sub/exist-XXXXX', 3); ok(! $mc->directory_exists("$brokenlink/exist"), "directory brokenlink/exist not created 2"); ok(! $mc->directory_exists($brokenlink), "brokenlink still not a directory 2"); @@ -803,13 +652,13 @@ ok($mc->directory_exists($basetempdir), "Testdir basedir exists"); # remove all permissions on basedir chmod(0000, $basetempdir); -init_exception("temp directory creation failure NoAction=0 permission"); +init_exception($mc, "temp directory creation failure NoAction=0 permission"); ok(!defined($mc->directory($tempdir, temp => 1)), "temp directory on parent without permissions returns undef on failure tempdir"); # called 2 times: init and _safe_eval -verify_exception("temp directory creation failure NoAction=0 permission", +verify_exception($mc, "temp directory creation failure NoAction=0 permission", '^Failed to create temporary directory target/test/check/sub/exist-XXXXX: Error in tempdir\(\) using target/test/check/sub/exist-XXXXX: Could not create directory target/test/check/sub/exist-\w{5}: Permission denied at', 2); # reset write bits for removal @@ -838,12 +687,12 @@ $CAF::Object::NoAction = 1; rmtree($basetest) if -d $basetest; # Test non-existingfile -init_exception("status (missing/noaction=1)"); +init_exception($mc, "status (missing/noaction=1)"); ok(! $mc->file_exists($statusfile), "status testfile does not exists missing/noaction=1"); is($mc->status($statusfile, mode => 0400), CHANGED, "status on missing file returns success on missing/noaction=1"); -verify_exception("status (missing/noaction=1)"); +verify_exception($mc, "status (missing/noaction=1)"); ok(! $mc->file_exists($statusfile), "status testfile still does not exists missing/noaction=1"); @@ -852,11 +701,11 @@ $CAF::Object::NoAction = 0; rmtree($basetest) if -d $basetest; # Test non-existingfile -init_exception("status (missing/noaction=0)"); +init_exception($mc, "status (missing/noaction=0)"); ok(! $mc->file_exists($statusfile), "status testfile does not exists missing/noaction=0"); ok(! defined($mc->status($statusfile, mode => 0400)), "status on missing file returns undef missing/noaction=0"); -verify_exception("status (missing/noaction=0)", +verify_exception($mc, "status (missing/noaction=0)", '\*\*\* lstat\(target/test/check/status\): No such file or directory'); ok(! $mc->file_exists($statusfile), "status testfile still does not exists missing/noaction=0"); @@ -957,13 +806,13 @@ ok($mc->directory_exists($movedir1), "move testdir exists"); my $nrfiles = scalar grep {-f $_} glob("$movedir2/*"); is($nrfiles, 2, "$nrfiles files in dest dir before move"); -init_exception("move NoAction=0"); +init_exception($mc, "move NoAction=0"); is($mc->move($movesrc1, $movedest1, '.old'), CHANGED, "move src $movesrc1 to dest $movedest1 with backup '.old'"); # 4 calls, # one from init move # two from hardlink from backup (init hardlink and function_catch) # one from safe_eval FCmove -verify_exception("move NoAction=0", undef, 4); +verify_exception($mc, "move NoAction=0", undef, 4); ok(! $mc->file_exists($movesrc1), "move src file does not exists, was moved"); ok($mc->file_exists($movedest1), "move dest file exists after move"); @@ -988,9 +837,9 @@ ok($mc->directory_exists($movedir1), "move testdir exists w/o backup"); $nrfiles = scalar grep {-f $_} glob("$movedir2/*"); is($nrfiles, 2, "$nrfiles files in dest dir before move w/o backup"); -init_exception("move w/o backup NoAction=0"); +init_exception($mc, "move w/o backup NoAction=0"); is($mc->move($movesrc1, $movedest1, ''), CHANGED, "move src $movesrc1 to dest $movedest1 w/o backup"); -verify_exception("move w/o backup NoAction=0", undef, 2); # move init, safe eval FCmove +verify_exception($mc, "move w/o backup NoAction=0", undef, 2); # move init, safe eval FCmove ok(! $mc->file_exists($movesrc1), "move src file does not exists, was moved w/o backup"); ok($mc->file_exists($movedest1), "move dest file exists after move w/o backup"); is(readfile($movedest1), 'source', 'dest file has source content w/o backup'); @@ -1010,12 +859,12 @@ ok(!$mc->file_exists($movedest1b), "move dest backup file does not exists w/o ba ok($mc->directory_exists($movedir1), "move testdir exists w/o backup w/o destdir"); ok(!$mc->directory_exists($movedir2), "move dest testdir does not exists w/o backup w/o destdir"); -init_exception("move w/o backup w/o destdir NoAction=0"); +init_exception($mc, "move w/o backup w/o destdir NoAction=0"); is($mc->move($movesrc1, $movedest1, ''), CHANGED, "move src $movesrc1 to dest $movedest1 w/o backup w/o destdir"); # move, # directory + func_catch + status/LC_Chekc/func_catch # safe eval FCmove -verify_exception("move w/o backup w/o destdir NoAction=0", undef, 5); +verify_exception($mc, "move w/o backup w/o destdir NoAction=0", undef, 5); ok(! $mc->file_exists($movesrc1), "move src file does not exists, was moved w/o backup w/o destdir"); ok($mc->directory_exists($movedir2), "move dest testdir does exists after move w/o backup w/o destdir"); ok($mc->file_exists($movedest1), "move dest file exists after move w/o backup w/o destdir"); @@ -1035,20 +884,20 @@ my $movedest2 = "$brokenlink/sub/dst"; ok(symlink("really_really_missing", $brokenlink), "broken symlink created 1"); # no backup, there's no dest to backup anyway -init_exception("move failure to create destdir"); +init_exception($mc, "move failure to create destdir"); ok(! defined($mc->move($movesrc1, $movedest2, '')), "move src $movesrc1 to dest $movedest1 w/o backup failed no permission to create destdir"); -verify_exception("move failure to create destdir", +verify_exception($mc, "move failure to create destdir", '^Failed to create basedir for dest target/test/check/broken_symlink/sub/dst: \*\*\* mkdir\(target/test/check/broken_symlink, 0755\): File exists', 3); # make destdir and remove all permissions mkpath $movedir2; chmod(0000, $movedir2); # no backup, there's no dest to backup anyway -init_exception("move failure to move source"); +init_exception($mc, "move failure to move source"); ok(! defined($mc->move($movesrc1, $movedest1, '')), "move src $movesrc1 to dest $movedest1 w/o backup failed no permission to move src to dest (destdor exists)"); -verify_exception("move failure to move source", +verify_exception($mc, "move failure to move source", '^Failed to move target/test/check/move1/src to target/test/check/move2/dst: Permission denied', 2); chmod(0700, $movedir2); @@ -1057,10 +906,10 @@ writefile($movedest1, 'dest'); # do not set 0000, or else Path cannot detect that dest exists # and thus no backup is taken, and we get different failure chmod(0500, $movedir2); -init_exception("move failure to cleanup dest with backup"); +init_exception($mc, "move failure to cleanup dest with backup"); ok(! defined($mc->move($movesrc1, $movedest1, '.old')), "move src $movesrc1 to dest $movedest1 with backup '.old' failed no permission to make backup of dest"); -verify_exception("move failure to cleanup dest with backup", +verify_exception($mc, "move failure to cleanup dest with backup", '^move: backup of dest target/test/check/move2/dst to target/test/check/move2/dst.old failed: \*\*\* link\(target/test/check/move2/dst, target/test/check/move2/dst.old\): Permission denied', 3); # Restore sufficient permissions @@ -1177,11 +1026,11 @@ $readdir = undef; ok(! defined($mc->listdir($listdir)), "listdir returns undef when _listdir returns undef"); # listdir with mocked _listdir -init_exception("listdir"); +init_exception($mc, "listdir"); $readdir = [qw(x A a B b)]; is_deeply($mc->listdir($listdir), [qw(A B a b x)], "listdir w/o options returns sorted list of all files without . and .."); -verify_exception("listdir", undef, 1); +verify_exception($mc, "listdir", undef, 1); # test is_deeply($mc->listdir($listdir, test => sub {return $_[0] eq 'A';}), From d387657fdc46bda40294f6797f7d6dc3aea7ed83 Mon Sep 17 00:00:00 2001 From: stdweird Date: Sat, 11 Nov 2017 15:32:43 +0100 Subject: [PATCH 2/2] Exception: _safe_eval support array context --- src/main/perl/Exception.pm | 18 +++++++++++++----- src/test/perl/exception.t | 16 ++++++++++++---- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/src/main/perl/Exception.pm b/src/main/perl/Exception.pm index 72c015d5..645637a1 100755 --- a/src/main/perl/Exception.pm +++ b/src/main/perl/Exception.pm @@ -141,7 +141,8 @@ at verbose level. Note that C<_safe_eval> doesn't work with functions that don't return a defined value when they succeed. -Resets previous fail attribute and or exceptions (via the C instance C). +Resets previous fail attribute and or exceptions +(via the C instance C). =cut @@ -156,9 +157,16 @@ sub _safe_eval %opts = %$optsref if $optsref; local $@; - my $res = eval { - $funcref->(@args, %opts); - }; + my @res; + my $res; + # TODO: is there a cleaner way to avoid the copy/paste of the right hand side? + if (wantarray) { + @res = eval { $funcref->(@args, %opts);}; + # set $res, even in wantarray; it's used below + $res = "@res"; + } else { + $res = eval { $funcref->(@args, %opts);}; + } # $res is undef if there is a syntax or runtime error or if the evaluated # function returns undef (interpreted as a function error). @@ -173,7 +181,7 @@ sub _safe_eval return $self->fail("$failmsg$err_msg"); } - return $res; + return wantarray ? @res : $res; } diff --git a/src/test/perl/exception.t b/src/test/perl/exception.t index 5979dab3..281d454b 100644 --- a/src/test/perl/exception.t +++ b/src/test/perl/exception.t @@ -164,7 +164,7 @@ verify_exception($tco, "_function_catch fail", '\*\*\* failure_func failed: no r my $funcref = sub { my ($ok, %opts) = @_; if ($ok) { - return "hooray $opts{test}"; + return wantarray ? ("ARRAY", "hooray", $opts{test}) : "hooray $opts{test}"; } else { die "bad day today $opts{test}"; } @@ -177,16 +177,24 @@ $mockobj->mock('verbose', sub {shift; push(@$verbose, \@_);}); init_exception($tco, "_safe_eval ok"); $verbose = []; -is($tco->_safe_eval($funcref, [1], {test => 123}, "eval fail", "eval ok", $ec), "hooray 123", - "_safe_eval with non-die function returns returnvalue"); +my $res = $tco->_safe_eval($funcref, [1], {test => 123}, "eval fail", "eval ok", $ec); +is($res, "hooray 123", + "_safe_eval with non-die function returns returnvalue SCALAR context"); is_deeply($verbose, [['eval ok: ', 'hooray 123']], "_safe_eval reports result verbose"); init_exception($tco, "_safe_eval ok pt2"); +$verbose = []; +my @res = $tco->_safe_eval($funcref, [1], {test => 456}, "eval fail", "eval ok", $ec); +is_deeply(\@res, ["ARRAY", "hooray", 456], + "_safe_eval with non-die function returns returnvalue ARRAY context"); + +init_exception($tco, "_safe_eval ok pt3"); + $verbose = []; $tco->{sensitive} = 1; is($tco->_safe_eval($funcref, [1], {test => 123}, "eval fail", "eval ok", $ec), "hooray 123", - "_safe_eval with non-die function returns returnvalue pt2"); + "_safe_eval with non-die function returns returnvalue pt3"); is_deeply($verbose, [['eval ok: ', '']], "_safe_eval does not report result verbose with sensitive=1");