Make ‘No such class’ apply to ${$ref}{key}, too

$ perl -le 'use fields "foo"; my main $r; $r->{bar}'
No such class field "bar" in variable $r of type main at -e line 1.
$ perl -le 'use fields "foo"; my main $r; $$r{bar}'
No such class field "bar" in variable $r of type main at -e line 1.
$ perl -le 'use fields "foo"; my main $r; ${$r}{bar}'
$

Notice how the last one is silent.  There is already code to handle
the block for hash slices, so we can copy that.

diff --git a/op.c b/op.c
index 6541c2d..deec760 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1902,9 +1902,19 @@ S_finalize_op(pTHX_ OP* o)
            break;
 
        rop = (UNOP*)((BINOP*)o)->op_first;
-       if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
+       if (rop->op_type != OP_RV2HV)
            break;
-       lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
+       if (rop->op_first->op_type == OP_PADSV)
+           /* $$hash{key} */
+           rop = (UNOP*)rop->op_first;
+       else if (rop->op_first->op_type == OP_SCOPE
+            && cLISTOPx(rop->op_first)->op_last->op_type == OP_PADSV)
+           /* ${$hash}{key} */
+           rop = (UNOP*)cLISTOPx(rop->op_first)->op_last;
+       else
+           break;
+
+       lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE);
        if (!SvPAD_TYPED(lexname))
            break;
        fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);

diff --git a/t/lib/croak/op b/t/lib/croak/op
index 4b0e997..31af174 100644 (file)
--- a/t/lib/croak/op
+++ b/t/lib/croak/op
@@ -17,6 +17,13 @@ $f->{c} = 1;
 EXPECT
 No such class field "c" in variable $f of type Foo at - line 8.
 ########
+# NAME "No such field" with block: ${$ref}{key}
+%FIELDS; # empty hash so all keys are invalid
+my main $r;
+${$r}{key};
+EXPECT
+No such class field "key" in variable $r of type main at - line 3.
+########
 # NAME OP_HSLICE fields
 package Foo;
 use fields qw(a b);