BEGIN {
require '../../t/test.pl';
- plan(392);
+ plan(435);
use_ok('XS::APItest')
};
for my $fn_type (0..2) { # 0:eval_pv 1:eval_sv 2:call_sv
my $warn_msg;
- local $SIG{__WARN__} = sub { $warn_msg = $_[0] };
+ local $SIG{__WARN__} = sub { $warn_msg .= $_[0] };
for my $code_type (0..3) {
)[$code_type];
for my $keep (0, G_KEEPERR) {
- next if $keep == G_KEEPERR; # XXX not fixed yet
my $keep_desc = $keep ? 'G_KEEPERR' : '0';
my $desc;
is($ret[-1], $expect, "$desc - return value");
if ($keep && $fn_type != 0) {
- is($@, 'pre-err', "$desc - \$@ unmodified");
+ # G_KEEPERR doesn't propagate into inner evals, requires etc
+ unless ($keep && $code_type == 2) {
+ is($@, 'pre-err', "$desc - \$@ unmodified");
+ }
$@ = $warn_msg;
}
else {
PERL_ARGS_ASSERT_QERROR;
- if (PL_in_eval)
- sv_catsv(ERRSV, err);
+ if (PL_in_eval) {
+ if (PL_in_eval & EVAL_KEEPERR) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %s",
+ SvPV_nolen_const(err));
+ }
+ else
+ sv_catsv(ERRSV, err);
+ }
else if (PL_errors)
sv_catsv(PL_errors, err);
else