From 0e706dd460930c194c46e123bb21021b04c3f691 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 3 Nov 2013 14:02:32 -0800 Subject: [PATCH] =?utf8?q?Make=20=E2=80=98No=20such=20field=E2=80=99=20err?= =?utf8?q?or=20apply=20to=201-elem=20slices?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit e75d1f10 added ‘No such class field’. It has never worked for single- element slices. --- op.c | 16 +++++++++------- t/lib/croak/op | 7 +++++++ 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/op.c b/op.c index ab4642a..a6d08bc 100644 --- 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 --- 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 -- 2.7.4