diff options
| -rw-r--r-- | sv.c | 10 | ||||
| -rwxr-xr-x | t/op/tie.t | 10 |
2 files changed, 19 insertions, 1 deletions
@@ -5928,8 +5928,16 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) pv1 = ""; cur1 = 0; } - else + else { + /* if pv1 and pv2 are the same, second SvPV_const call may + * invalidate pv1, so we may need to make a copy */ + if (sv1 == sv2 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) { + pv1 = SvPV_const(sv1, cur1); + sv1 = sv_2mortal(newSVpvn(pv1, cur1)); + if (SvUTF8(sv2)) SvUTF8_on(sv1); + } pv1 = SvPV_const(sv1, cur1); + } if (!sv2){ pv2 = ""; diff --git a/t/op/tie.t b/t/op/tie.t index 1d676eaa1c..a8d79fbc93 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -612,3 +612,13 @@ print scalar keys %h, "\n"; EXPECT 0 0 +######## +# Bug 37731 +sub foo::TIESCALAR { bless {value => $_[1]}, $_[0] } +sub foo::FETCH { $_[0]->{value} } +tie my $VAR, 'foo', '42'; +foreach my $var ($VAR) { + print +($var eq $VAR) ? "yes\n" : "no\n"; +} +EXPECT +yes |