diff options
| -rw-r--r-- | lib/overload.t | 2 | ||||
| -rw-r--r-- | pod/perldelta.pod | 6 | ||||
| -rw-r--r-- | sv.c | 13 |
3 files changed, 17 insertions, 4 deletions
diff --git a/lib/overload.t b/lib/overload.t index b1a75e513a..c97b87cc37 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -1906,7 +1906,7 @@ foreach my $op (qw(<=> == != < <= > >=)) { # eval should do tie, overload on its arg before checking taint */ push @tests, [ '1;', 'eval q(eval %s); $@ =~ /Insecure/', - '("")', '("")', [ 1, 2, 0 ], 0 ]; + '("")', '("")', [ 1, 1, 0 ], 0 ]; for my $sub (keys %subs) { diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 79028470c4..47b3cc0641 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -395,6 +395,12 @@ Also, embedded C<NUL> characters are now allowed in the input. If locale collation is not enabled on the platform (C<LC_COLLATE>), the input is returned unchanged. +=item * + +Double FETCH during stringification of tied scalars returning an +overloaded object have been fixed. The FETCH method should only be +called once, but prior to this release was actually called twice. + =back =head1 Known Problems @@ -2830,21 +2830,28 @@ char * Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const U32 flags) { char *s; + bool done_gmagic = FALSE; PERL_ARGS_ASSERT_SV_2PV_FLAGS; assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVFM); - if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) + if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) { mg_get(sv); + done_gmagic = TRUE; + } + if (SvROK(sv)) { if (SvAMAGIC(sv)) { SV *tmpstr; + SV *nsv= (SV *)sv; if (flags & SV_SKIP_OVERLOAD) return NULL; - tmpstr = AMG_CALLunary(sv, string_amg); + if (done_gmagic) + nsv = sv_mortalcopy_flags(sv,0); + tmpstr = AMG_CALLunary(nsv, string_amg); TAINT_IF(tmpstr && SvTAINTED(tmpstr)); - if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { + if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(nsv)))) { /* Unwrap this: */ /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */ |