diff --git a/charclass_invlists.inc b/charclass_invlists.inc index 855ae3d196f9..cc5ebd75833e 100644 --- a/charclass_invlists.inc +++ b/charclass_invlists.inc @@ -492661,6 +492661,6 @@ static const U8 WB_dfa_table[] = { * 03640d8ad18fc65de766f2034a927f7442960e998d3243845ca9b9fe31bfe1ab lib/unicore/mktables * 8c30575264b2772c7a69c5bb6069a28f0e0a7a0df735871bde2d99ee674316ac lib/unicore/version * 0a6b5ab33bb1026531f816efe81aea1a8ffcd34a27cbea37dd6a70a63d73c844 regen/charset_translations.pl - * c7ff8e0d207d3538c7feb4a1a152b159e5e902d20293b303569ea8323e84633e regen/mk_PL_charclass.pl + * 6c52efdee47313cfde75ff86376008ce53320ebc93176caab45c77ce086a256d regen/mk_PL_charclass.pl * 20a6e3d507a66f4594586485568134873485b08e23383f3dc4e6b3047569267b regen/mk_invlists.pl * ex: set ro ft=c: */ diff --git a/gv.c b/gv.c index 9856e03a2b7a..fde82cd94f36 100644 --- a/gv.c +++ b/gv.c @@ -2086,45 +2086,13 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, PERL_ARGS_ASSERT_GV_MAGICALIZE; - if (stash != PL_defstash) { /* not the main stash */ - /* We only have to check for a few names here: a, b, EXPORT, ISA - and VERSION. All the others apply only to the main stash or to - CORE (which is checked right after this). */ - if (len) { - switch (*name) { - case 'E': - if ( - len >= 6 && name[1] == 'X' && - (memEQs(name, len, "EXPORT") - ||memEQs(name, len, "EXPORT_OK") - ||memEQs(name, len, "EXPORT_FAIL") - ||memEQs(name, len, "EXPORT_TAGS")) - ) - GvMULTI_on(gv); - break; - case 'I': - if (memEQs(name, len, "ISA")) - gv_magicalize_isa(gv); - break; - case 'V': - if (memEQs(name, len, "VERSION")) - GvMULTI_on(gv); - break; - case 'a': - if (stash == PL_debstash && memEQs(name, len, "args")) { - GvMULTI_on(gv_AVadd(gv)); - break; - } - /* FALLTHROUGH */ - case 'b': - if (len == 1 && sv_type == SVt_PV) - GvMULTI_on(gv); - /* FALLTHROUGH */ - default: - goto try_core; - } - goto ret; - } + if (len == 0) { + return false; + } + + if (! generic_isCC_(*name, CC_MAGICAL_)) { + + /* If not a magical variable, it could be for CORE */ try_core: if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) { /* Avoid null warning: */ @@ -2134,24 +2102,44 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, } } else if (len > 1) { -#ifndef EBCDIC - if (*name > 'V' ) { - NOOP; - /* Nothing else to do. - The compiler will probably turn the switch statement into a - branch table. Make sure we avoid even that small overhead for - the common case of lower case variable names. (On EBCDIC - platforms, we can't just do: - if (NATIVE_TO_ASCII(*name) > NATIVE_TO_ASCII('V') ) { - because cases like '\027' in the switch statement below are - C1 (non-ASCII) controls on those platforms, so the remapping - would make them larger than 'V') - */ - } else -#endif - { + switch (*name) { + + /* Each in first set doesn't require this to be the main stash */ + + case 'E': + if ( (len >= 6 && name[1] == 'X') + && ( memEQs(name, len, "EXPORT") + ||memEQs(name, len, "EXPORT_OK") + ||memEQs(name, len, "EXPORT_FAIL") + ||memEQs(name, len, "EXPORT_TAGS"))) + { + GvMULTI_on(gv); + } + break; + case 'I': + if (memEQs(name, len, "ISA")) + gv_magicalize_isa(gv); + break; + case 'V': + if (memEQs(name, len, "VERSION")) + GvMULTI_on(gv); + break; + case 'a': + if (stash == PL_debstash && memEQs(name, len, "args")) { + GvMULTI_on(gv_AVadd(gv)); + break; + } + goto try_core; + + default: + + /* The remainder apply only to the main stash */ + if (stash != PL_defstash) { + goto try_core; + } + switch (*name) { - case 'A': + case 'A': if (memEQs(name, len, "ARGV")) { IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; } @@ -2159,22 +2147,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, GvMULTI_on(gv); } break; - case 'E': - if ( - len >= 6 && name[1] == 'X' && - (memEQs(name, len, "EXPORT") - ||memEQs(name, len, "EXPORT_OK") - ||memEQs(name, len, "EXPORT_FAIL") - ||memEQs(name, len, "EXPORT_TAGS")) - ) - GvMULTI_on(gv); - break; - case 'I': - if (memEQs(name, len, "ISA")) { - gv_magicalize_isa(gv); - } - break; - case 'S': + case 'S': if (memEQs(name, len, "SIG")) { HV *hv; I32 i; @@ -2205,11 +2178,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, } } break; - case 'V': - if (memEQs(name, len, "VERSION")) - GvMULTI_on(gv); - break; - case '\003': /* $^CHILD_ERROR_NATIVE */ + case '\003': /* $^CHILD_ERROR_NATIVE */ if (memEQs(name, len, "\003HILD_ERROR_NATIVE")) goto magicalize; /* @{^CAPTURE} %{^CAPTURE} */ @@ -2223,41 +2192,42 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0); } else /* %{^CAPTURE_ALL} */ - if (memEQs(name, len, "\003APTURE_ALL")) { + if (memEQs(name, len, "\003APTURE_ALL")) { require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0); } break; - case '\005': /* ${^ENCODING} */ + case '\005': /* ${^ENCODING} */ if (memEQs(name, len, "\005NCODING")) goto magicalize; break; - case '\007': /* ${^GLOBAL_PHASE} */ + case '\007': /* ${^GLOBAL_PHASE} */ if (memEQs(name, len, "\007LOBAL_PHASE")) goto ro_magicalize; break; - case '\010': /* %{^HOOK} */ + case '\010': /* %{^HOOK} */ if (memEQs(name, len, "\010OOK")) { GvMULTI_on(gv); HV *hv = GvHVn(gv); hv_magic(hv, NULL, PERL_MAGIC_hook); } break; - case '\014': - if ( memEQs(name, len, "\014AST_FH") || /* ${^LAST_FH} */ - memEQs(name, len, "\014AST_SUCCESSFUL_PATTERN")) /* ${^LAST_SUCCESSFUL_PATTERN} */ + case '\014': + if ( memEQs(name, len, "\014AST_FH") /* ${^LAST_FH} */ + || memEQs(name, len, "\014AST_SUCCESSFUL_PATTERN")) + /* ${^LAST_SUCCESSFUL_PATTERN} */ goto ro_magicalize; break; - case '\015': /* ${^MATCH} */ + case '\015': /* ${^MATCH} */ if (memEQs(name, len, "\015ATCH")) { paren = RX_BUFF_IDX_CARET_FULLMATCH; goto storeparen; } break; - case '\017': /* ${^OPEN} */ + case '\017': /* ${^OPEN} */ if (memEQs(name, len, "\017PEN")) goto magicalize; break; - case '\020': /* ${^PREMATCH} ${^POSTMATCH} */ + case '\020': /* ${^PREMATCH} ${^POSTMATCH} */ if (memEQs(name, len, "\020REMATCH")) { paren = RX_BUFF_IDX_CARET_PREMATCH; goto storeparen; @@ -2267,15 +2237,15 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, goto storeparen; } break; - case '\023': + case '\023': if (memEQs(name, len, "\023AFE_LOCALES")) goto ro_magicalize; break; - case '\024': /* ${^TAINT} */ + case '\024': /* ${^TAINT} */ if (memEQs(name, len, "\024AINT")) goto ro_magicalize; break; - case '\025': /* ${^UNICODE}, ${^UTF8LOCALE} */ + case '\025': /* ${^UNICODE}, ${^UTF8LOCALE} */ if (memEQs(name, len, "\025NICODE")) goto ro_magicalize; if (memEQs(name, len, "\025TF8LOCALE")) @@ -2283,7 +2253,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, if (memEQs(name, len, "\025TF8CACHE")) goto magicalize; break; - case '\027': /* $^WARNING_BITS */ + case '\027': /* $^WARNING_BITS */ if (memEQs(name, len, "\027ARNING_BITS")) goto magicalize; #ifdef WIN32 @@ -2291,84 +2261,88 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, goto magicalize; #endif break; - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - { + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + { /* Ensures that we have an all-digit variable, ${"1foo"} fails this test */ UV uv; if (!grok_atoUV(name, &uv, NULL) || uv > I32_MAX) - goto ret; + break; /* XXX why are we using a SSize_t? */ paren = (SSize_t)(I32)uv; goto storeparen; - } + } } } - } else { - /* Names of length 1. (Or 0. But name is NUL terminated, so that will - be case '\0' in this switch statement (ie a default case) */ + } + else if ( stash == PL_defstash /* Names of length 1. */ + || *name == 'a' || *name == 'b') + { + /* All but the above two length 1 names have to be in the main stash. + * + * Note that nothing failing here can apply to CORE, because the + * minimum length (for things like 'uc') is 2. */ + switch (*name) { - case '&': /* $& */ + case '&': /* $& */ paren = RX_BUFF_IDX_FULLMATCH; goto sawampersand; - case '`': /* $` */ + case '`': /* $` */ paren = RX_BUFF_IDX_PREMATCH; goto sawampersand; - case '\'': /* $' */ + case '\'': /* $' */ paren = RX_BUFF_IDX_POSTMATCH; - sawampersand: + sawampersand: #ifdef PERL_SAWAMPERSAND - if (!( - sv_type == SVt_PVAV || - sv_type == SVt_PVHV || - sv_type == SVt_PVCV || - sv_type == SVt_PVFM || - sv_type == SVt_PVIO - )) { PL_sawampersand |= - (*name == '`') - ? SAWAMPERSAND_LEFT - : (*name == '&') - ? SAWAMPERSAND_MIDDLE - : SAWAMPERSAND_RIGHT; - } + if (! ( sv_type == SVt_PVAV + || sv_type == SVt_PVHV + || sv_type == SVt_PVCV + || sv_type == SVt_PVFM + || sv_type == SVt_PVIO)) + { + PL_sawampersand |= (*name == '`') ? SAWAMPERSAND_LEFT + : (*name == '&') ? SAWAMPERSAND_MIDDLE + : SAWAMPERSAND_RIGHT; + } #endif goto storeparen; - case '1': /* $1 */ - case '2': /* $2 */ - case '3': /* $3 */ - case '4': /* $4 */ - case '5': /* $5 */ - case '6': /* $6 */ - case '7': /* $7 */ - case '8': /* $8 */ - case '9': /* $9 */ + + case '1': /* $1 */ + case '2': /* $2 */ + case '3': /* $3 */ + case '4': /* $4 */ + case '5': /* $5 */ + case '6': /* $6 */ + case '7': /* $7 */ + case '8': /* $8 */ + case '9': /* $9 */ paren = *name - '0'; - storeparen: + storeparen: /* Flag the capture variables with a NULL mg_ptr Use mg_len for the array index to lookup. */ sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, NULL, paren); break; - case ':': /* $: */ + case ':': /* $: */ sv_setpv(GvSVn(gv),PL_chopset); goto magicalize; - case '?': /* $? */ + case '?': /* $? */ #ifdef COMPLEX_STATUS SvUPGRADE(GvSVn(gv), SVt_PVLV); #endif goto magicalize; - case '!': /* $! */ + case '!': /* $! */ GvMULTI_on(gv); /* If %! has been used, automatically load Errno.pm. */ @@ -2379,8 +2353,8 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, require_tie_mod_s(gv, '!', "Errno", 1); break; - case '-': /* $-, %-, @- */ - case '+': /* $+, %+, @+ */ + case '-': /* $-, %-, @- */ + case '+': /* $+, %+, @+ */ GvMULTI_on(gv); /* no used once warnings here */ { /* $- $+ */ sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); @@ -2399,90 +2373,89 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, SvREADONLY_on(av); } break; - case '*': /* $* */ - case '#': /* $# */ - if (sv_type == SVt_PV) - /* diag_listed_as: $* is no longer supported as of Perl 5.30 */ - croak("$%c is no longer supported as of Perl 5.30", *name); - break; - case '\010': /* $^H */ + case '*': /* $* */ + case '#': /* $# */ + if (sv_type == SVt_PV) + /* diag_listed_as: $* is no longer supported as of Perl 5.30 */ + croak("$%c is no longer supported as of Perl 5.30", *name); + break; + case '\010': /* $^H */ { HV *const hv = GvHVn(gv); hv_magic(hv, NULL, PERL_MAGIC_hints); } goto magicalize; - case '\023': /* $^S */ - ro_magicalize: + case '\023': /* $^S */ + ro_magicalize: SvREADONLY_on(GvSVn(gv)); /* FALLTHROUGH */ - case '0': /* $0 */ - case '^': /* $^ */ - case '~': /* $~ */ - case '=': /* $= */ - case '%': /* $% */ - case '.': /* $. */ - case '(': /* $( */ - case ')': /* $) */ - case '<': /* $< */ - case '>': /* $> */ - case '\\': /* $\ */ - case '/': /* $/ */ - case '|': /* $| */ - case '$': /* $$ */ - case '[': /* $[ */ - case '\001': /* $^A */ - case '\003': /* $^C */ - case '\004': /* $^D */ - case '\005': /* $^E */ - case '\006': /* $^F */ - case '\011': /* $^I, NOT \t in EBCDIC */ - case '\016': /* $^N */ - case '\017': /* $^O */ - case '\020': /* $^P */ - case '\024': /* $^T */ - case '\027': /* $^W */ - magicalize: + case '0': /* $0 */ + case '^': /* $^ */ + case '~': /* $~ */ + case '=': /* $= */ + case '%': /* $% */ + case '.': /* $. */ + case '(': /* $( */ + case ')': /* $) */ + case '<': /* $< */ + case '>': /* $> */ + case '\\': /* $\ */ + case '/': /* $/ */ + case '|': /* $| */ + case '$': /* $$ */ + case '[': /* $[ */ + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\016': /* $^N */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\024': /* $^T */ + case '\027': /* $^W */ + magicalize: sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); break; - case '\014': /* $^L */ + case '\014': /* $^L */ sv_setpvs(GvSVn(gv),"\f"); break; - case ';': /* $; */ + case ';': /* $; */ sv_setpvs(GvSVn(gv),"\034"); break; - case ']': /* $] */ - { + case ']': /* $] */ + { SV * const sv = GvSV(gv); if (!sv_derived_from(PL_patchlevel, "version")) upg_version(PL_patchlevel, TRUE); GvSV(gv) = vnumify(PL_patchlevel); SvREADONLY_on(GvSV(gv)); SvREFCNT_dec(sv); - } - break; - case '\026': /* $^V */ - { + break; + } + + case '\026': /* $^V */ + { SV * const sv = GvSV(gv); GvSV(gv) = new_version(PL_patchlevel); SvREADONLY_on(GvSV(gv)); SvREFCNT_dec(sv); - } - break; - case 'a': - case 'b': + break; + } + + case 'a': /* The len > 1 case was handled above */ + case 'b': if (sv_type == SVt_PV) GvMULTI_on(gv); + break; } } - ret: /* Return true if we actually did something. */ return GvAV(gv) || GvHV(gv) || GvIO(gv) || GvCV(gv) - || ( GvSV(gv) && ( - SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv)) - ) - ); + || (GvSV(gv) && (SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv)))); } /* If we do ever start using this later on in the file, we need to make diff --git a/handy.h b/handy.h index d06292dd6ca9..0ada57f2d2e3 100644 --- a/handy.h +++ b/handy.h @@ -1542,8 +1542,9 @@ or casts # define CC_BINDIGIT_ 23 # define CC_OCTDIGIT_ 24 # define CC_MNEMONIC_CNTRL_ 25 +# define CC_MAGICAL_ 26 -/* Unused: 26-31 +/* Unused: 27-31 * If more bits are needed, one could add a second word for non-64bit * QUAD_IS_INT systems, using some #ifdefs to distinguish between having a 2nd * word or not. The IS_IN_SOME_FOLD bit is the most easily expendable, as it diff --git a/l1_char_class_tab.h b/l1_char_class_tab.h index 01d77639171a..dd6fc5296945 100644 --- a/l1_char_class_tab.h +++ b/l1_char_class_tab.h @@ -9,29 +9,29 @@ #if 'A' == 65 /* ASCII/Latin1 */ /* U+00 NUL */ (1U<' */ (1U<' */ (1U<' */ (1U<' */ (1U<' */ (1U<' */ (1U<mg_ptr, CC_MAGICAL_)); + switch (*mg->mg_ptr) { case '\001': /* ^A */ if (SvOK(PL_bodytarget)) sv_copypv(sv, PL_bodytarget); @@ -3016,6 +3019,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) return 0; } + assert(generic_isCC_(*mg->mg_ptr, CC_MAGICAL_)); + switch (*mg->mg_ptr) { case '\001': /* ^A */ if (SvOK(sv)) sv_copypv(PL_bodytarget, sv); diff --git a/regen/mk_PL_charclass.pl b/regen/mk_PL_charclass.pl index bcb002d42559..9072772ddf41 100644 --- a/regen/mk_PL_charclass.pl +++ b/regen/mk_PL_charclass.pl @@ -56,6 +56,19 @@ # These are the control characters that there are mnemonics for MNEMONIC_CNTRL => [ ord "\a", ord "\b", ord "\e", ord "\f", ord "\n", ord "\r", ord "\t" ], + MAGICAL => [ 001, 003, 004, 005, 006, 007, 010, 011, 014, 015, + 016, 017, 020, 023, 024, 025, 026, 027, + ord('0'), ord('1'), ord('2'), ord('3'), ord('4'), + ord('5'), ord('6'), ord('7'), ord('8'), ord('9'), + ord('a'), ord('b'), + ord('A'), ord('E'), ord('I'), ord('S'), ord('V'), + ord('!'), ord('#'), ord('%'), ord('&'), ord('('), + ord(')'), ord('*'), ord('+'), ord('-'), ord('.'), + ord('/'), ord(';'), ord(':'), ord('<'), ord('='), + ord('>'), ord('?'), ord('['), ord('\''), ord('\\'), + ord(']'), ord('^'), ord('`'), ord('|'), ord('~'), + ord('$'), + ], ); sub uniques { diff --git a/regexp_constants.h b/regexp_constants.h index 5df5462ef64b..f576861bfe2f 100644 --- a/regexp_constants.h +++ b/regexp_constants.h @@ -82,6 +82,6 @@ * 03640d8ad18fc65de766f2034a927f7442960e998d3243845ca9b9fe31bfe1ab lib/unicore/mktables * 8c30575264b2772c7a69c5bb6069a28f0e0a7a0df735871bde2d99ee674316ac lib/unicore/version * 0a6b5ab33bb1026531f816efe81aea1a8ffcd34a27cbea37dd6a70a63d73c844 regen/charset_translations.pl - * c7ff8e0d207d3538c7feb4a1a152b159e5e902d20293b303569ea8323e84633e regen/mk_PL_charclass.pl + * 6c52efdee47313cfde75ff86376008ce53320ebc93176caab45c77ce086a256d regen/mk_PL_charclass.pl * 20a6e3d507a66f4594586485568134873485b08e23383f3dc4e6b3047569267b regen/mk_invlists.pl * ex: set ro ft=c: */ diff --git a/uni_keywords.h b/uni_keywords.h index 6e81a518e32e..4e553e138151 100644 --- a/uni_keywords.h +++ b/uni_keywords.h @@ -8174,7 +8174,7 @@ match_uniprop( const unsigned char * const key, const U16 key_len ) { * 03640d8ad18fc65de766f2034a927f7442960e998d3243845ca9b9fe31bfe1ab lib/unicore/mktables * 8c30575264b2772c7a69c5bb6069a28f0e0a7a0df735871bde2d99ee674316ac lib/unicore/version * 0a6b5ab33bb1026531f816efe81aea1a8ffcd34a27cbea37dd6a70a63d73c844 regen/charset_translations.pl - * c7ff8e0d207d3538c7feb4a1a152b159e5e902d20293b303569ea8323e84633e regen/mk_PL_charclass.pl + * 6c52efdee47313cfde75ff86376008ce53320ebc93176caab45c77ce086a256d regen/mk_PL_charclass.pl * 20a6e3d507a66f4594586485568134873485b08e23383f3dc4e6b3047569267b regen/mk_invlists.pl * d6987e01ad538d1567394851cf199f99815f7701bebd6092be4bc7a6d8f147c6 regen/mph.pl * ex: set ro ft=c: */