summaryrefslogtreecommitdiff
path: root/universal.c
diff options
context:
space:
mode:
authorZefram <zefram@fysh.org>2017-11-22 17:23:57 +0000
committerZefram <zefram@fysh.org>2017-11-22 17:23:57 +0000
commit5f3202fa3e77c4a20de590df045af4683aaedffa (patch)
tree5572a671df6c4586c7d77cf8f98787eb0f457f07 /universal.c
parent5e1cca32ac612f0b59508a99fbff671a693f39b9 (diff)
downloadperl-5f3202fa3e77c4a20de590df045af4683aaedffa.tar.gz
eviscerate smartmatch
Regularise smartmatch's operand handling, by removing the implicit enreferencement and just supplying scalar context. Eviscerate its runtime behaviour, by removing all the matching rules other than rhs overloading. Overload smartmatching in the Regexp package to perform regexp matching. There are consequential customisations to autodie, in two areas. Firstly, autodie::exception objects are matchers, but autodie has been advising smartmatching with the exception on the lhs. This has to change to the rhs, in both documentation and tests. Secondly, it uses smartmatching as part of its hint mechanism. Most of the hint examples, in documentation and tests, have to change to subroutines, to be portable across Perl versions.
Diffstat (limited to 'universal.c')
-rw-r--r--universal.c34
1 files changed, 34 insertions, 0 deletions
diff --git a/universal.c b/universal.c
index 2262939b8d..30b70ac2f6 100644
--- a/universal.c
+++ b/universal.c
@@ -986,6 +986,34 @@ XS(XS_re_regexp_pattern)
NOT_REACHED; /* NOTREACHED */
}
+XS(XS_Regexp_smartmatch); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Regexp_smartmatch)
+{
+ dXSARGS;
+ SV *regexp_sv, *matchee_sv;
+ REGEXP *rx;
+ regexp *prog;
+ const char *strstart, *strend;
+ STRLEN len;
+
+ if (items != 3)
+ croak_xs_usage(cv, "regexp, matchee, swap");
+ matchee_sv = SP[-1];
+ regexp_sv = SP[-2];
+ SP -= 2;
+ PUTBACK;
+ assert(SvROK(regexp_sv));
+ rx = (REGEXP*)SvRV(regexp_sv);
+ assert(SvTYPE((SV*)rx) == SVt_REGEXP);
+ prog = ReANY(rx);
+ strstart = SvPV_const(matchee_sv, len);
+ assert(strstart);
+ strend = strstart + len;
+ TOPs = boolSV((RXp_MINLEN(prog) < 0 || len >= (STRLEN)RXp_MINLEN(prog)) &&
+ CALLREGEXEC(rx, (char*)strstart, (char *)strend,
+ (char*)strstart, 0, matchee_sv, NULL, 0));
+}
+
#include "vutil.h"
#include "vxs.inc"
@@ -1020,6 +1048,9 @@ static const struct xsub_details details[] = {
{"re::regnames", XS_re_regnames, ";$"},
{"re::regnames_count", XS_re_regnames_count, ""},
{"re::regexp_pattern", XS_re_regexp_pattern, "$"},
+ {"Regexp::((", XS_Regexp_smartmatch, NULL},
+ {"Regexp::()", XS_Regexp_smartmatch, NULL},
+ {"Regexp::(~~", XS_Regexp_smartmatch, NULL},
};
STATIC OP*
@@ -1108,6 +1139,9 @@ Perl_boot_core_UNIVERSAL(pTHX)
*cvfile = (char *)file;
Safefree(oldfile);
}
+
+ /* overload fallback flag for Regexp */
+ sv_setiv(get_sv("Regexp::()", GV_ADD), 1);
}
/*