diff options
| author | Nicholas Clark <nick@ccl4.org> | 2013-08-29 12:16:11 +0200 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2013-09-02 16:04:02 +0200 |
| commit | 960b831ff120c543264734d4a83b1eef6da166a7 (patch) | |
| tree | 6cd949de7a3ca43f9db611b2302c5ac5a0c38e73 /gv.c | |
| parent | e91d825996027800803ecf00fccacdcb821d3295 (diff) | |
| download | perl-960b831ff120c543264734d4a83b1eef6da166a7.tar.gz | |
Store all other match vars in mg_len instead of mg_ptr/mg_len.
Perl_gv_fetchpvn_flags() now stores the appropriate RX_BUFF_IDX_* constant
in mg_len for $` $' ${^MATCH} ${^PREMATCH} and ${^POSTMATCH}
This makes some code in mg.c unreachable and hence unnecessary; the next
commit will remove it.
Diffstat (limited to 'gv.c')
| -rw-r--r-- | gv.c | 38 |
1 files changed, 26 insertions, 12 deletions
@@ -1419,6 +1419,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; U32 faking_it; + SSize_t paren; PERL_ARGS_ASSERT_GV_FETCHPVN_FLAGS; @@ -1827,16 +1828,24 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, goto ro_magicalize; break; case '\015': /* $^MATCH */ - if (strEQ(name2, "ATCH")) - goto magicalize; + if (strEQ(name2, "ATCH")) { + paren = RX_BUFF_IDX_CARET_FULLMATCH; + goto storeparen; + } break; case '\017': /* $^OPEN */ if (strEQ(name2, "PEN")) goto magicalize; break; case '\020': /* $^PREMATCH $^POSTMATCH */ - if (strEQ(name2, "REMATCH") || strEQ(name2, "OSTMATCH")) - goto magicalize; + if (strEQ(name2, "REMATCH")) { + paren = RX_BUFF_IDX_CARET_PREMATCH; + goto storeparen; + } + if (strEQ(name2, "OSTMATCH")) { + paren = RX_BUFF_IDX_CARET_POSTMATCH; + goto storeparen; + } break; case '\024': /* ${^TAINT} */ if (strEQ(name2, "AINT")) @@ -1871,9 +1880,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, while (--end > name) { if (!isDIGIT(*end)) goto add_magical_gv; } - sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, NULL, - strtoul(name, NULL, 10)); - break; + paren = strtoul(name, NULL, 10); + goto storeparen; } } } @@ -1882,8 +1890,14 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, be case '\0' in this switch statement (ie a default case) */ switch (*name) { case '&': /* $& */ + paren = RX_BUFF_IDX_FULLMATCH; + goto sawampersand; case '`': /* $` */ + paren = RX_BUFF_IDX_PREMATCH; + goto sawampersand; case '\'': /* $' */ + paren = RX_BUFF_IDX_POSTMATCH; + sawampersand: #ifdef PERL_SAWAMPERSAND if (!( sv_type == SVt_PVAV || @@ -1899,9 +1913,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, : SAWAMPERSAND_RIGHT; } #endif - if (*name != '&') - goto magicalize; - /* FALL THROUGH */ + goto storeparen; case '1': /* $1 */ case '2': /* $2 */ case '3': /* $3 */ @@ -1911,10 +1923,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case '7': /* $7 */ case '8': /* $8 */ case '9': /* $9 */ + paren = *name - '0'; + + 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, - *name == '&' ? 0 : *name - '0'); + sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, NULL, paren); break; case ':': /* $: */ |