Skip to content

Commit 1b81858

Browse files
committed
S_newONCEOP/Perl_scalarvoid: skip over padops useless in void context
Prior to this commit, padops associated with OP_ONCE might serve no purpose in a void context. Since the context is not known at the point of the OP_ONCE creation, the padops have retained the STATE flag, but not the LVINTRO flag. This prevented Perl_scalarvoid from warning "Useless use of private variable in void context". In this commit, the STATE flag is removed and Perl_scalarvoid modified such that when a OP_ONCE padop is found in void context, the op_next pointer on the OP_ONCE is silently modified to skip over the padop.
1 parent 2efb6d3 commit 1b81858

File tree

3 files changed

+20
-12
lines changed

3 files changed

+20
-12
lines changed

ext/B/t/optree_varinit.t

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -405,8 +405,6 @@ checkOptree ( name => 'void context state',
405405
# 3 <|> once(other->4)[$:2,3] vK/1
406406
# 4 <$> const[IV 1] s
407407
# 5 <1> padsv_store[$x:2,3] vKS/LVINTRO,STATE
408-
# goto 6
409-
# 8 <0> padsv[$x:2,3] v/STATE
410408
# 6 <;> nextstate(main 3 -e:1) v:%,{,fea=15
411409
# 7 <@> leave[1 ref] vKP/REFC
412410
EOT_EOT
@@ -415,8 +413,6 @@ EOT_EOT
415413
# 3 <|> once(other->4)[$:2,3] vK/1
416414
# 4 <$> const(IV 1) s
417415
# 5 <1> padsv_store[$x:2,3] vKS/LVINTRO,STATE
418-
# goto 6
419-
# 8 <0> padsv[$x:2,3] v/STATE
420416
# 6 <;> nextstate(main 3 -e:1) v:%,{,fea=15
421417
# 7 <@> leave[1 ref] vKP/REFC
422418
EONT_EONT
@@ -433,7 +429,7 @@ checkOptree ( name => 'scalar context state',
433429
# 5 <0> padsv[$x:2,3] sRM*/LVINTRO,STATE
434430
# 6 <2> sassign sKS/2
435431
# goto 7
436-
# a <0> padsv[$x:2,3] s/STATE
432+
# a <0> padsv[$x:2,3] s
437433
# 7 <1> padsv_store[$y:2,3] vKS/LVINTRO
438434
# 8 <;> nextstate(main 3 -e:1) v:%,{,fea=15
439435
# 9 <@> leave[1 ref] vKP/REFC
@@ -445,7 +441,7 @@ EOT_EOT
445441
# 5 <0> padsv[$x:2,3] sRM*/LVINTRO,STATE
446442
# 6 <2> sassign sKS/2
447443
# goto 7
448-
# a <0> padsv[$x:2,3] s/STATE
444+
# a <0> padsv[$x:2,3] s
449445
# 7 <1> padsv_store[$y:2,3] vKS/LVINTRO
450446
# 8 <;> nextstate(main 3 -e:1) v:%,{,fea=15
451447
# 9 <@> leave[1 ref] vKP/REFC

op.c

Lines changed: 15 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2257,9 +2257,19 @@ Perl_scalarvoid(pTHX_ OP *arg)
22572257
case OP_ASLICE:
22582258
case OP_HELEM:
22592259
case OP_HSLICE:
2260-
if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
2261-
/* Otherwise it's "Useless use of grep iterator" */
2262-
useless = OP_DESC(o);
2260+
if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO))) {
2261+
if ((op_parent(o)->op_type == OP_ONCE) &&
2262+
(op_parent(o)->op_next == o)
2263+
){
2264+
/* An already set "state" OP has been encounted
2265+
* and there's no point pushing anything to the
2266+
* stack in void context. */
2267+
op_parent(o)->op_next = o->op_next;
2268+
} else {
2269+
/* Otherwise it's "Useless use of grep iterator" */
2270+
useless = OP_DESC(o);
2271+
}
2272+
}
22632273
break;
22642274

22652275
case OP_SPLIT:
@@ -8597,8 +8607,8 @@ S_newONCEOP(pTHX_ OP *initop, OP *padop)
85978607
{
85988608
const PADOFFSET target = padop->op_targ;
85998609
OP *const nexop = newOP(padop->op_type,
8600-
(padop->op_flags & ~(OPf_REF|OPf_MOD|OPf_SPECIAL))
8601-
| ((padop->op_private & ~OPpLVAL_INTRO) << 8));
8610+
(padop->op_flags & ~(OPf_REF|OPf_MOD|OPf_SPECIAL|OPf_WANT))
8611+
| ((padop->op_private & ~(OPpLVAL_INTRO|OPpPAD_STATE)) << 8));
86028612
OP *const first = newOP(OP_NULL, 0);
86038613
OP *const nullop = newCONDOP(0, first, initop, nexop);
86048614
/* XXX targlex disabled for now; see ticket #124160

t/op/state.t

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ BEGIN {
99

1010
use strict;
1111

12-
plan tests => 164;
12+
plan tests => 166;
1313

1414
# Before loading feature.pm, test it with CORE::
1515
ok eval 'CORE::state $x = 1;', 'CORE::state outside of feature.pm scope';
@@ -509,10 +509,12 @@ for (1,2) {
509509
sub gh_18630H {state %h=(a=>1)}
510510
my $res = join '', gh_18630H, gh_18630H;
511511
is($res, "a1a1", 'HASH copied successfully in subroutine exit');
512+
is(scalar gh_18630H, 1, 'gh_18630H scalar call returns key count');
512513

513514
sub gh_18630A {state @a = qw(b 2)}
514515
$res = join '', gh_18630A , gh_18630A;
515516
is($res, "b2b2", 'ARRAY copied successfully in subroutine exit');
517+
is(scalar gh_18630A, 2, 'gh_18630A scalar call returns element count');
516518
}
517519

518520
__DATA__

0 commit comments

Comments
 (0)