diff options
| -rw-r--r-- | op.c | 24 | ||||
| -rw-r--r-- | opcode.h | 5 | ||||
| -rwxr-xr-x | opcode.pl | 4 | ||||
| -rw-r--r-- | opnames.h | 5 | ||||
| -rw-r--r-- | pp.c | 13 | ||||
| -rw-r--r-- | pp.sym | 1 | ||||
| -rw-r--r-- | pp_proto.h | 1 | ||||
| -rw-r--r-- | t/op/state.t | 15 |
8 files changed, 59 insertions, 9 deletions
@@ -6986,6 +6986,29 @@ Perl_ck_sassign(pTHX_ OP *o) return kid; } } + if (kid->op_sibling) { + OP *kkid = kid->op_sibling; + if (kkid->op_type == OP_PADSV + && (kkid->op_private & OPpLVAL_INTRO) + && SvPAD_STATE(*av_fetch(PL_comppad_name, kkid->op_targ, FALSE))) { + const PADOFFSET target = kkid->op_targ; + OP *const other = newOP(OP_PADSV, + kkid->op_flags + | ((kkid->op_private & ~OPpLVAL_INTRO) << 8)); + OP *const first = newOP(OP_NULL, 0); + OP *const nullop = newCONDOP(0, first, o, other); + OP *const condop = first->op_next; + /* hijacking PADSTALE for uninitialized state variables */ + SvPADSTALE_on(PAD_SVl(target)); + + condop->op_type = OP_ONCE; + condop->op_ppaddr = PL_ppaddr[OP_ONCE]; + condop->op_targ = target; + other->op_targ = target; + + return nullop; + } + } return o; } @@ -7984,6 +8007,7 @@ Perl_peep(pTHX_ register OP *o) case OP_DORASSIGN: case OP_COND_EXPR: case OP_RANGE: + case OP_ONCE: while (cLOGOP->op_other->op_type == OP_NULL) cLOGOP->op_other = cLOGOP->op_other->op_next; peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */ @@ -393,6 +393,7 @@ EXTCONST char* const PL_op_name[] = { "getlogin", "syscall", "lock", + "once", "custom", }; #endif @@ -761,6 +762,7 @@ EXTCONST char* const PL_op_desc[] = { "getlogin", "syscall", "lock", + "once", "unknown custom operator", }; #endif @@ -1143,6 +1145,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ MEMBER_TO_FPTR(Perl_pp_getlogin), MEMBER_TO_FPTR(Perl_pp_syscall), MEMBER_TO_FPTR(Perl_pp_lock), + MEMBER_TO_FPTR(Perl_pp_once), MEMBER_TO_FPTR(Perl_unimplemented_op), /* Perl_pp_custom */ } #endif @@ -1522,6 +1525,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ MEMBER_TO_FPTR(Perl_ck_null), /* getlogin */ MEMBER_TO_FPTR(Perl_ck_fun), /* syscall */ MEMBER_TO_FPTR(Perl_ck_rfun), /* lock */ + MEMBER_TO_FPTR(Perl_ck_null), /* once */ MEMBER_TO_FPTR(Perl_ck_null), /* custom */ } #endif @@ -1895,6 +1899,7 @@ EXTCONST U32 PL_opargs[] = { 0x0000000c, /* getlogin */ 0x0004281d, /* syscall */ 0x0000f604, /* lock */ + 0x00000600, /* once */ 0x00000000, /* custom */ }; #endif @@ -1047,4 +1047,8 @@ syscall syscall ck_fun imst@ S L # For multi-threading lock lock ck_rfun s% R +# For state support + +once once ck_null | + custom unknown custom operator ck_null 0 @@ -375,11 +375,12 @@ typedef enum opcode { OP_GETLOGIN, /* 357 */ OP_SYSCALL, /* 358 */ OP_LOCK, /* 359 */ - OP_CUSTOM, /* 360 */ + OP_ONCE, /* 360 */ + OP_CUSTOM, /* 361 */ OP_max } opcode; -#define MAXO 361 +#define MAXO 362 #define OP_phoney_INPUT_ONLY -1 #define OP_phoney_OUTPUT_ONLY -2 @@ -4932,6 +4932,19 @@ PP(pp_split) RETURN; } +PP(pp_once) +{ + dSP; + SV *const sv = PAD_SVl(PL_op->op_targ); + + if (SvPADSTALE(sv)) { + /* First time. */ + SvPADSTALE_off(sv); + RETURNOP(cLOGOP->op_other); + } + RETURNOP(cLOGOP->op_next); +} + PP(pp_lock) { dVAR; @@ -404,5 +404,6 @@ Perl_pp_egrent Perl_pp_getlogin Perl_pp_syscall Perl_pp_lock +Perl_pp_once # ex: set ro: diff --git a/pp_proto.h b/pp_proto.h index 431992c0b0..3a96e32837 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -405,5 +405,6 @@ PERL_PPDEF(Perl_pp_egrent) PERL_PPDEF(Perl_pp_getlogin) PERL_PPDEF(Perl_pp_syscall) PERL_PPDEF(Perl_pp_lock) +PERL_PPDEF(Perl_pp_once) /* ex: set ro: */ diff --git a/t/op/state.t b/t/op/state.t index fb2880d852..f7db80401c 100644 --- a/t/op/state.t +++ b/t/op/state.t @@ -10,7 +10,7 @@ BEGIN { use strict; use feature "state"; -plan tests => 37; +plan tests => 38; ok( ! defined state $uninit, q(state vars are undef by default) ); @@ -18,7 +18,7 @@ ok( ! defined state $uninit, q(state vars are undef by default) ); sub stateful { state $x; - state $y //= 1; + state $y = 1; my $z = 2; state ($t) //= 3; return ($x++, $y++, $z++, $t++); @@ -45,9 +45,9 @@ is( $t, 5, 'incremented state var, list syntax' ); # in a nested block sub nesting { - state $foo //= 10; + state $foo = 10; my $t; - { state $bar //= 12; $t = ++$bar } + { state $bar = 12; $t = ++$bar } ++$foo; return ($foo, $t); } @@ -83,7 +83,7 @@ is( $f2->(), 2, 'generator 2 once more' ); sub TIESCALAR {bless {}}; sub FETCH { ++$fetchcount; 18 }; tie my $y, "countfetches"; - sub foo { state $x //= $y; $x++ } + sub foo { state $x = $y; $x++ } ::is( foo(), 18, "initialisation with tied variable" ); ::is( foo(), 19, "increments correctly" ); ::is( foo(), 20, "increments correctly, twice" ); @@ -94,7 +94,7 @@ is( $f2->(), 2, 'generator 2 once more' ); sub gen_cashier { my $amount = shift; - state $cash_in_store; + state $cash_in_store = 0; return { add => sub { $cash_in_store += $amount }, del => sub { $cash_in_store -= $amount }, @@ -113,7 +113,7 @@ sub stateless { ++$reinitme; } is( stateless(), 43, 'stateless function, first time' ); -is( stateless(), 43, 'stateless function, second time' ); +is( stateless(), 44, 'stateless function, second time' ); # array state vars @@ -157,3 +157,4 @@ noseworth(2); sub pugnax { my $x = state $y = 42; $y++; $x; } is( pugnax(), 42, 'scalar state assignment return value' ); +is( pugnax(), 43, 'scalar state assignment return value' ); |