From 952306aca140c014b38ba5eb2ed71dffaa548f0f Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Wed, 3 May 2006 21:46:02 +0000 Subject: [PATCH] Introduce a new keyword, state, for state variables. p4raw-id: //depot/perl@28086 --- MANIFEST | 1 + dump.c | 1 + embed.fnc | 2 +- embed.h | 2 +- ext/B/B/Concise.pm | 4 +- ext/B/t/concise-xs.t | 2 +- keywords.h | 85 ++++++++++++++++++++------------------- keywords.pl | 1 + op.c | 25 +++++++++--- op.h | 5 +++ pad.c | 11 +++-- perl.h | 2 +- perl_keyword.pl | 4 +- pod/perlintern.pod | 2 +- pp_hot.c | 9 ++++- proto.h | 2 +- sv.h | 8 +++- t/op/state.t | 65 ++++++++++++++++++++++++++++++ toke.c | 111 +++++++++++++++++++++++++++++---------------------- 19 files changed, 234 insertions(+), 108 deletions(-) create mode 100644 t/op/state.t diff --git a/MANIFEST b/MANIFEST index 6f363a3..a367c87 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3440,6 +3440,7 @@ t/op/srand.t See if srand works t/op/sselect.t See if 4 argument select works t/op/stash.t See if %:: stashes work t/op/stat.t See if stat works +t/op/state.t See if state variables work t/op/study.t See if study works t/op/studytied.t See if study works with tied scalars t/op/sub_lval.t See if lvalue subroutines work diff --git a/dump.c b/dump.c index a8d362a..c81ac8d 100644 --- a/dump.c +++ b/dump.c @@ -1244,6 +1244,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,"); if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,"); + if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,"); if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,"); if (GvIMPORTED(sv)) { sv_catpv(d, "IMPORT"); diff --git a/embed.fnc b/embed.fnc index 3abf027..ea91d6c 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1535,7 +1535,7 @@ s |void |deb_stack_n |NN SV** stack_base|I32 stack_min \ pda |PADLIST*|pad_new |int flags pd |void |pad_undef |NN CV* cv pd |PADOFFSET|pad_add_name |NN const char *name\ - |NULLOK HV* typestash|NULLOK HV* ourstash|bool clone + |NULLOK HV* typestash|NULLOK HV* ourstash|bool clone|bool state pd |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type pd |void |pad_check_dup |NN const char* name|bool is_our|NN const HV* ourstash #ifdef DEBUGGING diff --git a/embed.h b/embed.h index 7304c55..5edf4ba 100644 --- a/embed.h +++ b/embed.h @@ -3719,7 +3719,7 @@ #ifdef PERL_CORE #define pad_new(a) Perl_pad_new(aTHX_ a) #define pad_undef(a) Perl_pad_undef(aTHX_ a) -#define pad_add_name(a,b,c,d) Perl_pad_add_name(aTHX_ a,b,c,d) +#define pad_add_name(a,b,c,d,e) Perl_pad_add_name(aTHX_ a,b,c,d,e) #define pad_add_anon(a,b) Perl_pad_add_anon(aTHX_ a,b) #define pad_check_dup(a,b,c) Perl_pad_check_dup(aTHX_ a,b,c) #endif diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 5ce1d45..d8a259f 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.67"; +our $VERSION = "0.68"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -563,6 +563,7 @@ $priv{$_}{128} = "LVINTRO" $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite"); $priv{"aassign"}{64} = "COMMON"; $priv{"aassign"}{32} = "PHASH" if $] < 5.009; +$priv{"sassign"}{32} = "STATE"; $priv{"sassign"}{64} = "BKWARD"; $priv{$_}{64} = "RTIME" for ("match", "subst", "substcont", "qr"); @{$priv{"trans"}}{1,2,4,8,16,64} = ("UTF", "IDENT", "SQUASH", "DEL", @@ -571,6 +572,7 @@ $priv{"repeat"}{64} = "DOLIST"; $priv{"leaveloop"}{64} = "CONT"; @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV") for (qw(rv2gv rv2sv padsv aelem helem)); +$priv{"padsv"}{16} = "STATE"; @{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD"); @{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv"); $priv{"gv"}{32} = "EARLYCV"; diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t index 2ae87a1..11076592 100644 --- a/ext/B/t/concise-xs.t +++ b/ext/B/t/concise-xs.t @@ -120,7 +120,7 @@ use Test::More tests => ( # per-pkg tests (function ct + require_ok) + 511 + 235 # B::Deparse, B + 588 + 190 # POSIX, IO::Socket + 3 * ($] > 5.009) - + 14 * ($] >= 5.009003) + + 16 * ($] >= 5.009003) - 22); # fudge require_ok("B::Concise"); diff --git a/keywords.h b/keywords.h index fd2313a..45622e3 100644 --- a/keywords.h +++ b/keywords.h @@ -222,47 +222,48 @@ #define KEY_sqrt 207 #define KEY_srand 208 #define KEY_stat 209 -#define KEY_study 210 -#define KEY_sub 211 -#define KEY_substr 212 -#define KEY_symlink 213 -#define KEY_syscall 214 -#define KEY_sysopen 215 -#define KEY_sysread 216 -#define KEY_sysseek 217 -#define KEY_system 218 -#define KEY_syswrite 219 -#define KEY_tell 220 -#define KEY_telldir 221 -#define KEY_tie 222 -#define KEY_tied 223 -#define KEY_time 224 -#define KEY_times 225 -#define KEY_tr 226 -#define KEY_truncate 227 -#define KEY_uc 228 -#define KEY_ucfirst 229 -#define KEY_umask 230 -#define KEY_undef 231 -#define KEY_unless 232 -#define KEY_unlink 233 -#define KEY_unpack 234 -#define KEY_unshift 235 -#define KEY_untie 236 -#define KEY_until 237 -#define KEY_use 238 -#define KEY_utime 239 -#define KEY_values 240 -#define KEY_vec 241 -#define KEY_wait 242 -#define KEY_waitpid 243 -#define KEY_wantarray 244 -#define KEY_warn 245 -#define KEY_when 246 -#define KEY_while 247 -#define KEY_write 248 -#define KEY_x 249 -#define KEY_xor 250 -#define KEY_y 251 +#define KEY_state 210 +#define KEY_study 211 +#define KEY_sub 212 +#define KEY_substr 213 +#define KEY_symlink 214 +#define KEY_syscall 215 +#define KEY_sysopen 216 +#define KEY_sysread 217 +#define KEY_sysseek 218 +#define KEY_system 219 +#define KEY_syswrite 220 +#define KEY_tell 221 +#define KEY_telldir 222 +#define KEY_tie 223 +#define KEY_tied 224 +#define KEY_time 225 +#define KEY_times 226 +#define KEY_tr 227 +#define KEY_truncate 228 +#define KEY_uc 229 +#define KEY_ucfirst 230 +#define KEY_umask 231 +#define KEY_undef 232 +#define KEY_unless 233 +#define KEY_unlink 234 +#define KEY_unpack 235 +#define KEY_unshift 236 +#define KEY_untie 237 +#define KEY_until 238 +#define KEY_use 239 +#define KEY_utime 240 +#define KEY_values 241 +#define KEY_vec 242 +#define KEY_wait 243 +#define KEY_waitpid 244 +#define KEY_wantarray 245 +#define KEY_warn 246 +#define KEY_when 247 +#define KEY_while 248 +#define KEY_write 249 +#define KEY_x 250 +#define KEY_xor 251 +#define KEY_y 252 /* ex: set ro: */ diff --git a/keywords.pl b/keywords.pl index ac81d42..441d04b 100755 --- a/keywords.pl +++ b/keywords.pl @@ -257,6 +257,7 @@ sprintf sqrt srand stat +state study sub substr diff --git a/op.c b/op.c index 75d1850..970f27a 100644 --- a/op.c +++ b/op.c @@ -276,7 +276,8 @@ Perl_allocmy(pTHX_ char *name) if (PL_in_my_stash && *name != '$') { yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"", - name, is_our ? "our" : "my")); + name, + is_our ? "our" : PL_in_my == KEY_state ? "state" : "my")); } /* allocate a spare slot and store the name in that slot */ @@ -288,7 +289,8 @@ Perl_allocmy(pTHX_ char *name) ? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash) : NULL ), - 0 /* not fake */ + 0, /* not fake */ + PL_in_my == KEY_state ); return off; } @@ -1793,7 +1795,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) type == OP_RV2HV) { /* XXX does this let anything illegal in? */ if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */ yyerror(Perl_form(aTHX_ "Can't declare %s in %s", - OP_DESC(o), PL_in_my == KEY_our ? "our" : "my")); + OP_DESC(o), + PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my")); } else if (attrs) { GV * const gv = cGVOPx_gv(cUNOPo->op_first); PL_in_my = FALSE; @@ -1814,7 +1817,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) { yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"", OP_DESC(o), - PL_in_my == KEY_our ? "our" : "my")); + PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my")); return o; } else if (attrs && type != OP_PUSHMARK) { @@ -1831,6 +1834,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) } o->op_flags |= OPf_MOD; o->op_private |= OPpLVAL_INTRO; + if (PL_in_my == KEY_state) + o->op_private |= OPpPAD_STATE; return o; } @@ -2112,7 +2117,7 @@ Perl_localize(pTHX_ OP *o, I32 lex) if (sigil && (*s == ';' || *s == '=')) { Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS), "Parentheses missing around \"%s\" list", - lex ? (PL_in_my == KEY_our ? "our" : "my") + lex ? (PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my") : "local"); } } @@ -6802,6 +6807,16 @@ 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))) { + o->op_private |= OPpASSIGN_STATE; + /* hijacking PADSTALE for uninitialized state variables */ + SvPADSTALE_on(PAD_SVl(kkid->op_targ)); + } + } return o; } diff --git a/op.h b/op.h index 1c9375c..8c1bffb 100644 --- a/op.h +++ b/op.h @@ -149,6 +149,9 @@ Deprecated. Use C instead. #define OPpASSIGN_BACKWARDS 64 /* Left & right switched. */ #define OPpASSIGN_CV_TO_GV 128 /* Possible optimisation for constants. */ +/* Private for OP_[AS]ASSIGN */ +#define OPpASSIGN_STATE 32 /* Assign to a "state" variable */ + /* Private for OP_MATCH and OP_SUBST{,CONST} */ #define OPpRUNTIME 64 /* Pattern coming in on the stack */ @@ -187,6 +190,8 @@ Deprecated. Use C instead. #define OPpOUR_INTRO 16 /* Variable was in an our() */ /* OP_RV2[AH]V, OP_PAD[AH]V, OP_[AH]ELEM */ #define OPpMAYBE_LVSUB 8 /* We might be an lvalue to return */ + /* OP_PADSV only */ +#define OPpPAD_STATE 16 /* is a "state" pad */ /* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */ /* OP_RV2GV only */ diff --git a/pad.c b/pad.c index 80e930e..3b52c20 100644 --- a/pad.c +++ b/pad.c @@ -109,6 +109,7 @@ to be generated in evals, such as #include "EXTERN.h" #define PERL_IN_PAD_C #include "perl.h" +#include "keywords.h" #define PAD_MAX 999999999 @@ -333,7 +334,7 @@ If fake, it means we're cloning an existing entry */ PADOFFSET -Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake) +Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state) { dVAR; const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); @@ -354,6 +355,9 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake OURSTASH_set(namesv, ourstash); SvREFCNT_inc_simple_void_NN(ourstash); } + else if (state) { + SvPAD_STATE_on(namesv); + } av_store(PL_comppad_name, offset, namesv); if (fake) { @@ -539,7 +543,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) break; /* "our" masking "our" */ Perl_warner(aTHX_ packWARN(WARN_MISC), "\"%s\" variable %s masks earlier declaration in same %s", - (is_our ? "our" : "my"), + (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"), name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); --off; @@ -845,7 +849,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SvPAD_TYPED(*out_name_sv) ? SvSTASH(*out_name_sv) : NULL, OURSTASH(*out_name_sv), - 1 /* fake */ + 1, /* fake */ + 0 /* not a state variable */ ); new_namesv = AvARRAY(PL_comppad_name)[new_offset]; diff --git a/perl.h b/perl.h index de0137d..8e8d67b 100644 --- a/perl.h +++ b/perl.h @@ -3866,7 +3866,7 @@ EXTCONST char PL_no_dir_func[] EXTCONST char PL_no_func[] INIT("The %s function is unimplemented"); EXTCONST char PL_no_myglob[] - INIT("\"my\" variable %s can't be in a package"); + INIT("\"%s\" variable %s can't be in a package"); EXTCONST char PL_no_localize_ref[] INIT("Can't localize through a reference"); EXTCONST char PL_memory_wrap[] diff --git a/perl_keyword.pl b/perl_keyword.pl index 5806728..636f6a9 100644 --- a/perl_keyword.pl +++ b/perl_keyword.pl @@ -9,8 +9,8 @@ my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY default defined delete do END else eval elsif exists for format foreach given grep goto glob INIT if last local m my map next no our pos print printf package prototype q qr qq qw qx redo return require s scalar sort - split study sub tr tie tied use undef until untie unless when while - y); + split state study sub tr tie tied use undef until untie unless when + while y); my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless break bind binmode CORE cmp chr cos chop close chdir chomp chmod diff --git a/pod/perlintern.pod b/pod/perlintern.pod index 3190e09..7fc7114 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -712,7 +712,7 @@ OURSTASH to that value If fake, it means we're cloning an existing entry - PADOFFSET pad_add_name(const char *name, HV* typestash, HV* ourstash, bool clone) + PADOFFSET pad_add_name(const char *name, HV* typestash, HV* ourstash, bool clone, bool state) =for hackers Found in file pad.c diff --git a/pp_hot.c b/pp_hot.c index 0e56e10..6a879d7 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -120,6 +120,12 @@ PP(pp_sassign) SV * const temp = left; left = right; right = temp; } + else if (PL_op->op_private & OPpASSIGN_STATE) { + if (SvPADSTALE(right)) + SvPADSTALE_off(right); + else + RETURN; /* ignore assignment */ + } if (PL_tainting && PL_tainted && !SvTAINTED(left)) TAINT_NOT; if (PL_op->op_private & OPpASSIGN_CV_TO_GV) { @@ -273,7 +279,8 @@ PP(pp_padsv) XPUSHs(TARG); if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) - SAVECLEARSV(PAD_SVl(PL_op->op_targ)); + if (!(PL_op->op_private & OPpPAD_STATE)) + SAVECLEARSV(PAD_SVl(PL_op->op_targ)); if (PL_op->op_private & OPpDEREF) { PUTBACK; vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF); diff --git a/proto.h b/proto.h index db1b75f..1154162 100644 --- a/proto.h +++ b/proto.h @@ -4088,7 +4088,7 @@ PERL_CALLCONV PADLIST* Perl_pad_new(pTHX_ int flags) PERL_CALLCONV void Perl_pad_undef(pTHX_ CV* cv) __attribute__nonnull__(pTHX_1); -PERL_CALLCONV PADOFFSET Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool clone) +PERL_CALLCONV PADOFFSET Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool clone, bool state) __attribute__nonnull__(pTHX_1); PERL_CALLCONV PADOFFSET Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) diff --git a/sv.h b/sv.h index ec6184b..92a8e7f 100644 --- a/sv.h +++ b/sv.h @@ -284,6 +284,7 @@ perform the upgrade if necessary. See C. #define SVphv_CLONEABLE 0x00008000 /* PVHV (stashes) clone its objects */ #define SVs_PADSTALE 0x00010000 /* lexical has gone out of scope */ +#define SVpad_STATE 0x00010000 /* pad name is a "state" var */ #define SVs_PADTMP 0x00020000 /* in use as tmp */ #define SVpad_TYPED 0x00020000 /* pad name is a Typed Lexical */ #define SVs_PADMY 0x00040000 /* in use a "my" variable */ @@ -339,7 +340,8 @@ perform the upgrade if necessary. See C. keys live on shared string table */ /* PVNV, PVMG, PVGV, presumably only inside pads */ #define SVpad_NAME 0x40000000 /* This SV is a name in the PAD, so - SVpad_TYPED and SVpad_OUR apply */ + SVpad_TYPED, SVpad_OUR and + SVpad_STATE apply */ /* PVAV */ #define SVpav_REAL 0x40000000 /* free old entries */ /* PVHV */ @@ -1074,6 +1076,10 @@ the scalar's value cannot change unless written to. ((SvFLAGS(sv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR)) #define SvPAD_OUR_on(sv) (SvFLAGS(sv) |= SVpad_NAME|SVpad_OUR) +#define SvPAD_STATE(sv) \ + ((SvFLAGS(sv) & (SVpad_NAME|SVpad_STATE)) == (SVpad_NAME|SVpad_STATE)) +#define SvPAD_STATE_on(sv) (SvFLAGS(sv) |= SVpad_NAME|SVpad_STATE) + #define OURSTASH(sv) \ (SvPAD_OUR(sv) ? ((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash : NULL) #define OURSTASH_set(sv, st) \ diff --git a/t/op/state.t b/t/op/state.t new file mode 100644 index 0000000..987cf6e --- /dev/null +++ b/t/op/state.t @@ -0,0 +1,65 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require './test.pl'; +} + +use strict; + +plan tests => 19; + +ok( ! defined state $uninit, q(state vars are undef by default) ); + +sub stateful { + state $x; + state $y = 1; + my $z = 2; + return ($x++, $y++, $z++); +} + +my ($x, $y, $z) = stateful(); +is( $x, 0, 'uninitialized state var' ); +is( $y, 1, 'initialized state var' ); +is( $z, 2, 'lexical' ); + +($x, $y, $z) = stateful(); +is( $x, 1, 'incremented state var' ); +is( $y, 2, 'incremented state var' ); +is( $z, 2, 'reinitialized lexical' ); + +($x, $y, $z) = stateful(); +is( $x, 2, 'incremented state var' ); +is( $y, 3, 'incremented state var' ); +is( $z, 2, 'reinitialized lexical' ); + +sub nesting { + state $foo = 10; + my $t; + { state $bar = 12; $t = ++$bar } + ++$foo; + return ($foo, $t); +} + +($x, $y) = nesting(); +is( $x, 11, 'outer state var' ); +is( $y, 13, 'inner state var' ); + +($x, $y) = nesting(); +is( $x, 12, 'outer state var' ); +is( $y, 14, 'inner state var' ); + +sub generator { + my $outer; + # we use $outer to generate a closure + sub { ++$outer; ++state $x } +} + +my $f1 = generator(); +is( $f1->(), 1, 'generator 1' ); +is( $f1->(), 2, 'generator 1' ); +my $f2 = generator(); +is( $f2->(), 1, 'generator 2' ); +is( $f1->(), 3, 'generator 1 again' ); +is( $f2->(), 2, 'generator 2 once more' ); diff --git a/toke.c b/toke.c index b0c0ccc..3700e34 100644 --- a/toke.c +++ b/toke.c @@ -5964,6 +5964,7 @@ Perl_yylex(pTHX) case KEY_our: case KEY_my: + case KEY_state: PL_in_my = tmp; s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { @@ -6712,7 +6713,8 @@ S_pending_ident(pTHX) } else { if (strchr(PL_tokenbuf,':')) - yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf)); + yyerror(Perl_form(aTHX_ PL_no_myglob, + PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf)); yylval.opval = newOP(OP_PADANY, 0); yylval.opval->op_targ = allocmy(PL_tokenbuf); @@ -6830,7 +6832,7 @@ S_pending_ident(pTHX) I32 Perl_keyword (pTHX_ const char *name, I32 len) { - dVAR; + dVAR; switch (len) { case 1: /* 5 tokens of length 1 */ @@ -7737,46 +7739,46 @@ Perl_keyword (pTHX_ const char *name, I32 len) switch (name[1]) { case 'a': - switch (name[2]) - { - case 'i': - if (name[3] == 't') - { /* wait */ - return -KEY_wait; - } + switch (name[2]) + { + case 'i': + if (name[3] == 't') + { /* wait */ + return -KEY_wait; + } - goto unknown; + goto unknown; - case 'r': - if (name[3] == 'n') - { /* warn */ - return -KEY_warn; - } + case 'r': + if (name[3] == 'n') + { /* warn */ + return -KEY_warn; + } - goto unknown; + goto unknown; - default: - goto unknown; - } + default: + goto unknown; + } case 'h': if (name[2] == 'e' && name[3] == 'n') { /* when */ return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0); - } + } - goto unknown; + goto unknown; - default: - goto unknown; - } + default: + goto unknown; + } default: goto unknown; } - case 5: /* 38 tokens of length 5 */ + case 5: /* 39 tokens of length 5 */ switch (name[0]) { case 'B': @@ -7833,13 +7835,13 @@ Perl_keyword (pTHX_ const char *name, I32 len) { case 'l': if (name[2] == 'e' && - name[3] == 's' && - name[4] == 's') - { /* bless */ - return -KEY_bless; - } + name[3] == 's' && + name[4] == 's') + { /* bless */ + return -KEY_bless; + } - goto unknown; + goto unknown; case 'r': if (name[2] == 'e' && @@ -8136,14 +8138,29 @@ Perl_keyword (pTHX_ const char *name, I32 len) goto unknown; case 't': - if (name[2] == 'u' && - name[3] == 'd' && - name[4] == 'y') - { /* study */ - return KEY_study; - } + switch (name[2]) + { + case 'a': + if (name[3] == 't' && + name[4] == 'e') + { /* state */ + return KEY_state; + } - goto unknown; + goto unknown; + + case 'u': + if (name[3] == 'd' && + name[4] == 'y') + { /* study */ + return KEY_study; + } + + goto unknown; + + default: + goto unknown; + } default: goto unknown; @@ -8802,17 +8819,17 @@ Perl_keyword (pTHX_ const char *name, I32 len) case 'i': if (name[4] == 'n' && - name[5] == 'e' && - name[6] == 'd') - { /* defined */ - return KEY_defined; - } + name[5] == 'e' && + name[6] == 'd') + { /* defined */ + return KEY_defined; + } - goto unknown; + goto unknown; - default: - goto unknown; - } + default: + goto unknown; + } } goto unknown; -- 2.7.4