diff options
author | Yves Orton <demerphq@gmail.com> | 2016-10-31 22:44:31 +0100 |
---|---|---|
committer | Yves Orton <demerphq@gmail.com> | 2016-11-01 13:29:48 +0100 |
commit | 27deb0cf05ad74bec9ea0da3d1b6405346a66401 (patch) | |
tree | f40af34d9d18411571c3159c6cc104729969e672 /gv.c | |
parent | b634eb441c2bbbdbcd8dbcbbc4097658c7439a1f (diff) | |
download | perl-27deb0cf05ad74bec9ea0da3d1b6405346a66401.tar.gz |
new feature @{^CAPTURE} (and %{^CAPTURE} and %{^CAPTURE_ALL})
@{^CAPTURE} exposes the capture buffers of the last match
as an array. So $1 is ${^CAPTURE}[0].
%{^CAPTURE} is the equivalent to %+ (ie named captures)
%{^CAPTURE_ALL} is the equivalent to %- (ie all named captures).
Diffstat (limited to 'gv.c')
-rw-r--r-- | gv.c | 46 |
1 files changed, 32 insertions, 14 deletions
@@ -1975,6 +1975,22 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, case '\003': /* $^CHILD_ERROR_NATIVE */ if (memEQs(name, len, "\003HILD_ERROR_NATIVE")) goto magicalize; + /* @{^CAPTURE} %{^CAPTURE} */ + if (memEQs(name, len, "\003APTURE")) { + AV* const av = GvAVn(gv); + UV uv= *name; + + sv_magic(MUTABLE_SV(av), (SV*)uv, PERL_MAGIC_regdata, NULL, 0); + SvREADONLY_on(av); + + if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) + require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0); + + } else /* %{^CAPTURE_ALL} */ + if (memEQs(name, len, "\003APTURE_ALL")) { + if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) + require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0); + } break; case '\005': /* $^ENCODING */ if (memEQs(name, len, "\005NCODING")) @@ -2118,22 +2134,24 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, break; case '-': /* $-, %-, @- */ case '+': /* $+, %+, @+ */ - GvMULTI_on(gv); /* no used once warnings here */ - { - AV* const av = GvAVn(gv); - SV* const avc = (*name == '+') ? MUTABLE_SV(av) : NULL; - - sv_magic(MUTABLE_SV(av), avc, PERL_MAGIC_regdata, NULL, 0); - sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); - if (avc) - SvREADONLY_on(GvSVn(gv)); - SvREADONLY_on(av); - - if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) - require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture",0); + GvMULTI_on(gv); /* no used once warnings here */ + { /* $- $+ */ + sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); + if (*name == '+') + SvREADONLY_on(GvSVn(gv)); + } + { /* %- %+ */ + if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) + require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture",0); + } + { /* @- @+ */ + AV* const av = GvAVn(gv); + const UV uv = (UV)*name; + sv_magic(MUTABLE_SV(av), (SV*)uv, PERL_MAGIC_regdata, NULL, 0); + SvREADONLY_on(av); + } break; - } case '*': /* $* */ case '#': /* $# */ if (sv_type == SVt_PV) |