Band-aid fix for local([@%]$x)

This fixes the segfaults by extending the prohibition on `local($$x)'
to array and hash dereferences and removing the code that never
worked. It also adds simple test cases and a `through' to the error
message.

The new explanation in perldiag isn't terribly clear, but the old one
told an untruth.

It should be possible to make local([$@%]$x) work by adding a new
SAVEt type, and I'd like to do so in the future, but that certainly
wouldn't be maintenance patch material.

p5p-msgid: m0wsb7J-000EYPC@alias-2.pr.mcs.net

diff --git a/op.c b/op.c
index e37b23a..d412bcf 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1059,6 +1059,8 @@ I32 type;
 
     case OP_RV2AV:
     case OP_RV2HV:
+       if (!type && cUNOP->op_first->op_type != OP_GV)
+           croak("Can't localize through a reference");
        if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
            modcount = 10000;
            return op;          /* Treat \(@foo) like ordinary list. */
@@ -1080,7 +1082,7 @@ I32 type;
        break;
     case OP_RV2SV:
        if (!type && cUNOP->op_first->op_type != OP_GV)
-           croak("Can't localize a reference");
+           croak("Can't localize through a reference");
        ref(cUNOP->op_first, op->op_type); 
        /* FALL THROUGH */
     case OP_GV:

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1b0f92e..a5527dd 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -597,12 +597,12 @@ call for another.  It can't manufacture one out of whole cloth.  In general
 you should be calling it out of only an AUTOLOAD routine anyway.  See
 L<perlfunc/goto>.
 
-=item Can't localize a reference
+=item Can't localize through a reference
 
-(F) You said something like C<local $$ref>, which is not allowed because
-the compiler can't determine whether $ref will end up pointing to anything
-with a symbol table entry, and a symbol table entry is necessary to
-do a local.
+(F) You said something like C<local $$ref>, which Perl can't currently
+handle, because when it goes to restore the old value of whatever $ref
+pointed to after the scope of the local() is finished, it can't be
+sure that $ref will still be a reference.  
 
 =item Can't localize lexical variable %s
 

diff --git a/pp_hot.c b/pp_hot.c
index 2f044b9..f8f4362 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -426,8 +426,6 @@ PP(pp_rv2av)
        av = (AV*)SvRV(sv);
        if (SvTYPE(av) != SVt_PVAV)
            DIE("Not an ARRAY reference");
-       if (op->op_private & OPpLVAL_INTRO)
-           av = (AV*)save_svref((SV**)sv);
        if (op->op_flags & OPf_REF) {
            PUSHs((SV*)av);
            RETURN;
@@ -503,8 +501,6 @@ PP(pp_rv2hv)
        hv = (HV*)SvRV(sv);
        if (SvTYPE(hv) != SVt_PVHV)
            DIE("Not a HASH reference");
-       if (op->op_private & OPpLVAL_INTRO)
-           hv = (HV*)save_svref((SV**)sv);
        if (op->op_flags & OPf_REF) {
            SETs((SV*)hv);
            RETURN;

diff --git a/t/op/local.t b/t/op/local.t
index 0432010..f527c9c 100755 (executable)
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
 
-print "1..20\n";
+print "1..23\n";
 
 sub foo {
     local($a, $b) = @_;
@@ -43,3 +43,12 @@ $d{''} = "ok 18\n";
 print &foo2("ok 11\n","ok 12\n");
 
 print $a,@b,@c,%d,$x,$y;
+
+eval 'local($$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n";
+
+eval 'local(@$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
+
+eval 'local(%$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";