From: Yitzchak Scott-Thoennes <sthoenna@efn.org>
Date: Mon, 28 Nov 2005 01:26:31 +0000 (-0800)
Subject: Re: [perl #37731] junk and uninit'ed values in tied scalars
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ced497e2fca8b0ac1628855f422776e9bf331e65;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #37731] junk and uninit'ed values in tied scalars
Message-ID: <20051128092605.GA2328@efn.org>

plus a regression test

p4raw-id: //depot/perl@28684
---

diff --git a/sv.c b/sv.c
index 146d9e7..32939d2 100644
--- a/sv.c
+++ b/sv.c
@@ -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 1d676ea..a8d79fb 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