From: Dave Mitchell <davem@fdisolutions.com>
Date: Fri, 18 Jul 2003 18:49:43 +0000 (+0100)
Subject: Re: Reference to tied elements results in lvalue.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=be65207d0b2b85c02537b6bafe56904f5103ed15;p=p5sagit%2Fp5-mst-13.2.git

Re: Reference to tied elements results in lvalue.
Message-ID: <20030718174943.GB6427@fdgroup.com>

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

diff --git a/sv.c b/sv.c
index 251fd8a..542530d 100644
--- a/sv.c
+++ b/sv.c
@@ -3087,7 +3087,11 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 				    s = "REF";
 				else
 				    s = "SCALAR";		break;
-		case SVt_PVLV:	s = SvROK(sv) ? "REF":"LVALUE";	break;
+		case SVt_PVLV:	s = SvROK(sv) ? "REF"
+				/* tied lvalues should appear to be
+				 * scalars for backwards compatitbility */
+				: (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
+				    ? "SCALAR" : "LVALUE";	break;
 		case SVt_PVAV:	s = "ARRAY";			break;
 		case SVt_PVHV:	s = "HASH";			break;
 		case SVt_PVCV:	s = "CODE";			break;
@@ -7846,7 +7850,12 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob)
 				    return "REF";
 				else
 				    return "SCALAR";
-	case SVt_PVLV:		return SvROK(sv) ? "REF" : "LVALUE";
+				
+	case SVt_PVLV:		return SvROK(sv) ? "REF"
+				/* tied lvalues should appear to be
+				 * scalars for backwards compatitbility */
+				: (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
+				    ? "SCALAR" : "LVALUE";
 	case SVt_PVAV:		return "ARRAY";
 	case SVt_PVHV:		return "HASH";
 	case SVt_PVCV:		return "CODE";
diff --git a/t/op/tie.t b/t/op/tie.t
index dfbf44b..a3b4be2 100755
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -343,3 +343,20 @@ $a->{foo}; # access once
 print defined tied $a->{foo} ? "not ok" : "ok";
 EXPECT
 ok
+########
+# the tmps returned by FETCH should appear to be SCALAR
+# (even though they are now implemented using PVLVs.)
+package X;
+sub TIEHASH { bless {} }
+sub TIEARRAY { bless {} }
+sub FETCH {1}
+my (%h, @a);
+tie %h, 'X';
+tie @a, 'X';
+my $r1 = \$h{1};
+my $r2 = \$a[0];
+my $s = "$r1 ". ref($r1) . " $r2 " . ref($r2);
+$s=~ s/\(0x\w+\)//g;
+print $s, "\n";
+EXPECT
+SCALAR SCALAR SCALAR SCALAR