char *prune_from = NULL;
bool read_from_cache = FALSE;
STRLEN umaxlen;
+ SV *err = NULL;
PERL_ARGS_ASSERT_RUN_USER_FILTER;
PUSHs(filter_state);
}
PUTBACK;
- count = call_sv(filter_sub, G_SCALAR);
+ count = call_sv(filter_sub, G_SCALAR|G_EVAL);
SPAGAIN;
if (count > 0) {
if (SvOK(out)) {
status = SvIV(out);
}
+ else if (SvTRUE(ERRSV)) {
+ err = newSVsv(ERRSV);
+ }
}
PUTBACK;
LEAVE_with_name("call_filter_sub");
}
- if(SvOK(upstream)) {
+ if(!err && SvOK(upstream)) {
got_p = SvPV(upstream, got_len);
if (umaxlen) {
if (got_len > umaxlen) {
}
}
}
- if (prune_from) {
+ if (!err && prune_from) {
/* Oh. Too long. Stuff some in our cache. */
STRLEN cached_len = got_p + got_len - prune_from;
SV *const cache = datasv;
have touched the SV upstream, so it may be undefined. If we naively
concatenate it then we get a warning about use of uninitialised value.
*/
- if (upstream != buf_sv && (SvOK(upstream) || SvGMAGICAL(upstream))) {
+ if (!err && upstream != buf_sv &&
+ (SvOK(upstream) || SvGMAGICAL(upstream))) {
sv_catsv(buf_sv, upstream);
}
}
filter_del(S_run_user_filter);
}
+
+ if (err)
+ croak_sv(err);
+
if (status == 0 && read_from_cache) {
/* If we read some data from the cache (and by getting here it implies
that we emptied the cache) then we aren't yet at EOF, and mustn't
use strict;
-plan(tests => 49 + !is_miniperl() * (3 + 14 * $can_fork));
+plan(tests => 53 + !is_miniperl() * (3 + 14 * $can_fork));
sub get_temp_fh {
my $f = tempfile();
ok( 1, 'returning PVBM ref doesn\'t segfault use' );
shift @INC;
+# [perl #92252]
+{
+ my $die = sub { die };
+ my $data = [];
+ unshift @INC, sub { $die, $data };
+
+ my $initial_sub_refcnt = Internals::SvREFCNT($die);
+ my $initial_data_refcnt = Internals::SvREFCNT($data);
+
+ do "foo";
+ is(Internals::SvREFCNT($die), $initial_sub_refcnt, "no leaks");
+ is(Internals::SvREFCNT($data), $initial_data_refcnt, "no leaks");
+
+ do "bar";
+ is(Internals::SvREFCNT($die), $initial_sub_refcnt, "no leaks");
+ is(Internals::SvREFCNT($data), $initial_data_refcnt, "no leaks");
+
+ shift @INC;
+}
+
exit if is_miniperl();
SKIP: {