Change 31798 by [EMAIL PROTECTED] on 2007/09/06 09:18:41
Make state $zok = slosh(); behave as the Perl 6 design with an implicit
START block. First time through, call slosh() and assign to $zok.
Subsequently neither call slosh() nor assign to $zok. Adds a new op
ONCE to control the conditonal call and assign. No change to list
context, so state ($zok) = slosh() and (state $zok) = ... etc will
still repeatedly evaluate and assign. [Can't fix that before 5.10]
Use as an RVALUE is as Larry's design - my $boff = state $zok = ...;
will evaluate, assign and return first time, and subsequently act as if
it were written my $boff = $zok;
FIXME - state $zok = ...; won't deparse - I believe op->op_last isn't
being correctly set on the sassign, but I don't know how to fix this.
This change may be backed out before 5.10.
Affected files ...
... //depot/perl/op.c#950 edit
... //depot/perl/opcode.h#145 edit
... //depot/perl/opcode.pl#167 edit
... //depot/perl/opnames.h#25 edit
... //depot/perl/pp.c#598 edit
... //depot/perl/pp.sym#37 edit
... //depot/perl/pp_proto.h#45 edit
... //depot/perl/t/op/state.t#14 edit
Differences ...
==== //depot/perl/op.c#950 (text) ====
Index: perl/op.c
--- perl/op.c#949~31765~ 2007-08-30 06:49:14.000000000 -0700
+++ perl/op.c 2007-09-06 02:18:41.000000000 -0700
@@ -6986,6 +6986,29 @@
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 @@
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 */
==== //depot/perl/opcode.h#145 (text+w) ====
Index: perl/opcode.h
--- perl/opcode.h#144~30784~ 2007-03-30 04:48:54.000000000 -0700
+++ perl/opcode.h 2007-09-06 02:18:41.000000000 -0700
@@ -393,6 +393,7 @@
"getlogin",
"syscall",
"lock",
+ "once",
"custom",
};
#endif
@@ -761,6 +762,7 @@
"getlogin",
"syscall",
"lock",
+ "once",
"unknown custom operator",
};
#endif
@@ -1143,6 +1145,7 @@
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 @@
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 @@
0x0000000c, /* getlogin */
0x0004281d, /* syscall */
0x0000f604, /* lock */
+ 0x00000600, /* once */
0x00000000, /* custom */
};
#endif
==== //depot/perl/opcode.pl#167 (xtext) ====
Index: perl/opcode.pl
--- perl/opcode.pl#166~30785~ 2007-03-30 04:52:43.000000000 -0700
+++ perl/opcode.pl 2007-09-06 02:18:41.000000000 -0700
@@ -1047,4 +1047,8 @@
# For multi-threading
lock lock ck_rfun s% R
+# For state support
+
+once once ck_null |
+
custom unknown custom operator ck_null 0
==== //depot/perl/opnames.h#25 (text+w) ====
Index: perl/opnames.h
--- perl/opnames.h#24~30784~ 2007-03-30 04:48:54.000000000 -0700
+++ perl/opnames.h 2007-09-06 02:18:41.000000000 -0700
@@ -375,11 +375,12 @@
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
==== //depot/perl/pp.c#598 (text) ====
Index: perl/pp.c
--- perl/pp.c#597~31770~ 2007-08-31 02:07:51.000000000 -0700
+++ perl/pp.c 2007-09-06 02:18:41.000000000 -0700
@@ -4932,6 +4932,19 @@
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;
==== //depot/perl/pp.sym#37 (text+w) ====
Index: perl/pp.sym
--- perl/pp.sym#36~30784~ 2007-03-30 04:48:54.000000000 -0700
+++ perl/pp.sym 2007-09-06 02:18:41.000000000 -0700
@@ -404,5 +404,6 @@
Perl_pp_getlogin
Perl_pp_syscall
Perl_pp_lock
+Perl_pp_once
# ex: set ro:
==== //depot/perl/pp_proto.h#45 (text+w) ====
Index: perl/pp_proto.h
--- perl/pp_proto.h#44~30784~ 2007-03-30 04:48:54.000000000 -0700
+++ perl/pp_proto.h 2007-09-06 02:18:41.000000000 -0700
@@ -405,5 +405,6 @@
PERL_PPDEF(Perl_pp_getlogin)
PERL_PPDEF(Perl_pp_syscall)
PERL_PPDEF(Perl_pp_lock)
+PERL_PPDEF(Perl_pp_once)
/* ex: set ro: */
==== //depot/perl/t/op/state.t#14 (text) ====
Index: perl/t/op/state.t
--- perl/t/op/state.t#13~31049~ 2007-04-24 03:31:28.000000000 -0700
+++ perl/t/op/state.t 2007-09-06 02:18:41.000000000 -0700
@@ -10,7 +10,7 @@
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 @@
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 @@
# 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 @@
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 @@
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 @@
++$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 @@
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' );
End of Patch.
