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 (file)
--- 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 (executable)
--- 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