diff options
| -rw-r--r-- | embed.fnc | 3 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | op.c | 20 | ||||
| -rw-r--r-- | perly.act | 2 | ||||
| -rw-r--r-- | perly.y | 2 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | toke.c | 4 |
7 files changed, 22 insertions, 13 deletions
@@ -744,7 +744,8 @@ p |void |package_version|NN OP* v : Used in op.c pd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype : Used in toke.c and perly.y -p |PADOFFSET|allocmy |NN const char *const name +p |PADOFFSET|allocmy |NN const char *const name|const STRLEN len\ + |const U32 flags : Used in op.c and toke.c AMpdR |PADOFFSET|pad_findmy |NN const char* name|STRLEN len|U32 flags Ap |PADOFFSET|find_rundefsvoffset | @@ -3007,7 +3007,7 @@ #ifdef PERL_CORE #define package_version(a) Perl_package_version(aTHX_ a) #define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b) -#define allocmy(a) Perl_allocmy(aTHX_ a) +#define allocmy(a,b,c) Perl_allocmy(aTHX_ a,b,c) #endif #define pad_findmy(a,b,c) Perl_pad_findmy(aTHX_ a,b,c) #define find_rundefsvoffset() Perl_find_rundefsvoffset(aTHX) @@ -372,7 +372,7 @@ S_no_bareword_allowed(pTHX_ const OP *o) /* "register" allocation */ PADOFFSET -Perl_allocmy(pTHX_ const char *const name) +Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) { dVAR; PADOFFSET off; @@ -380,20 +380,28 @@ Perl_allocmy(pTHX_ const char *const name) PERL_ARGS_ASSERT_ALLOCMY; + if (flags) + Perl_croak(aTHX_ "panic: allocmy illegal flag bits 0x%" UVxf, + (UV)flags); + + /* Until we're using the length for real, cross check that we're being + told the truth. */ + assert(strlen(name) == len); + /* complain about "my $<special_var>" etc etc */ - if (*name && + if (len && !(is_our || isALPHA(name[1]) || (USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) || - (name[1] == '_' && (*name == '$' || name[2])))) + (name[1] == '_' && (*name == '$' || len > 2)))) { /* name[2] is true if strlen(name) > 2 */ if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) { - yyerror(Perl_form(aTHX_ "Can't use global %c^%c%s in \"%s\"", - name[0], toCTRL(name[1]), name + 2, + yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in \"%s\"", + name[0], toCTRL(name[1]), (int)(len - 2), name + 2, PL_parser->in_my == KEY_state ? "state" : "my")); } else { - yyerror(Perl_form(aTHX_ "Can't use global %s in \"%s\"",name, + yyerror(Perl_form(aTHX_ "Can't use global %.*s in \"%s\"", (int) len, name, PL_parser->in_my == KEY_state ? "state" : "my")); } } @@ -20,7 +20,7 @@ case 2: case 5: #line 161 "perly.y" - { (yyval.ival) = (I32) allocmy("$_"); ;} + { (yyval.ival) = (I32) Perl_allocmy(aTHX_ STR_WITH_LEN("$_"), 0); ;} break; case 6: @@ -158,7 +158,7 @@ remember: /* NULL */ /* start a full lexical scope */ ; mydefsv: /* NULL */ /* lexicalize $_ */ - { $$ = (I32) allocmy("$_"); } + { $$ = (I32) Perl_allocmy(aTHX_ STR_WITH_LEN("$_"), 0); } ; progstart: @@ -2357,7 +2357,7 @@ PERL_CALLCONV void Perl_package_version(pTHX_ OP* v) assert(v) PERL_CALLCONV PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype); -PERL_CALLCONV PADOFFSET Perl_allocmy(pTHX_ const char *const name) +PERL_CALLCONV PADOFFSET Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_ALLOCMY \ assert(name) @@ -7094,7 +7094,7 @@ S_pending_ident(pTHX) yyerror(Perl_form(aTHX_ "No package name allowed for " "variable %s in \"our\"", PL_tokenbuf)); - tmp = allocmy(PL_tokenbuf); + tmp = allocmy(PL_tokenbuf, tokenbuf_len, 0); } else { if (has_colon) @@ -7102,7 +7102,7 @@ S_pending_ident(pTHX) PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf)); pl_yylval.opval = newOP(OP_PADANY, 0); - pl_yylval.opval->op_targ = allocmy(PL_tokenbuf); + pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len, 0); return PRIVATEREF; } } |