summaryrefslogtreecommitdiff
path: root/gv.c
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2016-10-31 22:44:31 +0100
committerYves Orton <demerphq@gmail.com>2016-11-01 13:29:48 +0100
commit27deb0cf05ad74bec9ea0da3d1b6405346a66401 (patch)
treef40af34d9d18411571c3159c6cc104729969e672 /gv.c
parentb634eb441c2bbbdbcd8dbcbbc4097658c7439a1f (diff)
downloadperl-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.c46
1 files changed, 32 insertions, 14 deletions
diff --git a/gv.c b/gv.c
index 1cf0d8dd74..2dfb364402 100644
--- a/gv.c
+++ b/gv.c
@@ -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)