Make ‘No such field’ error apply to 1-elem slices

e75d1f10 added ‘No such class field’.  It has never worked for single-
element slices.

diff --git a/op.c b/op.c
index ab4642a..a6d08bc 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1924,14 +1924,16 @@ S_finalize_op(pTHX_ OP* o)
        SV *lexname;
        GV **fields;
        SV **svp;
-       SVOP *first_key_op, *key_op;
+       SVOP *key_op;
+       OP *kid;
 
        S_scalar_slice_warning(aTHX_ o);
 
        if ((o->op_private & (OPpLVAL_INTRO))
            /* I bet there's always a pushmark... */
-           || ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST)
-           /* hmmm, no optimization if list contains only one key. */
+           ||(  (kid = cLISTOPo->op_first->op_sibling)->op_type != OP_LIST
+             && kid->op_type != OP_CONST)
+           )
            break;
        rop = (UNOP*)((LISTOP*)o)->op_last;
        if (rop->op_type != OP_RV2HV)
@@ -1956,10 +1958,10 @@ S_finalize_op(pTHX_ OP* o)
        fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);
        if (!fields || !isGV(*fields) || !GvHV(*fields))
            break;
-       /* Again guessing that the pushmark can be jumped over.... */
-       first_key_op = (SVOP*)((LISTOP*)((LISTOP*)o)->op_first->op_sibling)
-           ->op_first->op_sibling;
-       for (key_op = first_key_op; key_op;
+       key_op = (SVOP*)(kid->op_type == OP_CONST
+                               ? kid
+                               : kLISTOP->op_first->op_sibling);
+       for (; key_op;
             key_op = (SVOP*)key_op->op_sibling) {
            if (key_op->op_type != OP_CONST)
                continue;

diff --git a/t/lib/croak/op b/t/lib/croak/op
index 22f1e76..4b0e997 100644 (file)
--- a/t/lib/croak/op
+++ b/t/lib/croak/op
@@ -29,6 +29,13 @@ my Foo $f = Foo->new;
 EXPECT
 No such class field "c" in variable $f of type Foo at - line 8.
 ########
+# NAME Single OP_HSLICE field
+%FIELDS; # vivify it, but leave it empty, so all fields are invalid
+my main $f;
+@$f{"a"};
+EXPECT
+No such class field "a" in variable $f of type main at - line 3.
+########
 # NAME delete BAD
 delete $x;
 EXPECT