#include "XSUB.h"
-/* a special string address whose value is "isa", but whicb perl knows
- * to treat as if it were really "DOES" */
-char PL_isa_DOES[] = "isa";
-
bool
Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags)
{
PUTBACK;
/* create a PV with value "isa", but with a special address
- * so that perl knows were' realling doing "DOES" instead */
+ * so that perl knows we're really doing "DOES" instead */
methodname = newSV_type(SVt_PV);
- SvLEN(methodname) = 0;
- SvCUR(methodname) = strlen(PL_isa_DOES);
- SvPVX(methodname) = PL_isa_DOES;
+ SvLEN_set(methodname, 0);
+ SvCUR_set(methodname, strlen(PL_isa_DOES));
+ SvPVX(methodname) = (char *)PL_isa_DOES; /* discard 'const' qualifier */
SvPOK_on(methodname);
sv_2mortal(methodname);
call_sv(methodname, G_SCALAR | G_METHOD);
SPAGAIN;
- does_it = SvTRUE( TOPs );
+ does_it = SvTRUE_NN( TOPs );
FREETMPS;
LEAVE;
if (items < 1 || items > 2)
croak_xs_usage(cv, "sv, failok=0");
else {
- SV * const sv = ST(0);
- const bool failok = (items < 2) ? 0 : SvTRUE(ST(1)) ? 1 : 0;
- const bool RETVAL = sv_utf8_downgrade(sv, failok);
+ SV * const sv0 = ST(0);
+ SV * const sv1 = ST(1);
+ const bool failok = (items < 2) ? 0 : SvTRUE_NN(sv1) ? 1 : 0;
+ const bool RETVAL = sv_utf8_downgrade(sv0, failok);
ST(0) = boolSV(RETVAL);
}
XSRETURN_NO;
}
else if (items == 2) {
- if (SvTRUE(ST(1))) {
+ SV *sv1 = ST(1);
+ if (SvTRUE_NN(sv1)) {
SvFLAGS(sv) |= SVf_READONLY;
XSRETURN_YES;
}
if (!rx)
XSRETURN_UNDEF;
- if (items == 2 && SvTRUE(ST(1))) {
+ if (items == 2 && SvTRUE_NN(ST(1))) {
flags = RXapif_ALL;
} else {
flags = RXapif_ONE;
if (!rx)
XSRETURN_UNDEF;
- if (items == 1 && SvTRUE(ST(0))) {
+ if (items == 1 && SvTRUE_NN(ST(0))) {
flags = RXapif_ALL;
} else {
flags = RXapif_ONE;
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"
{"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*
CV* to_native_cv = get_cv("utf8::unicode_to_native", 0);
CV* to_unicode_cv = get_cv("utf8::native_to_unicode", 0);
- cv_set_call_checker(to_native_cv,
+ cv_set_call_checker_flags(to_native_cv,
optimize_out_native_convert_function,
- (SV*) to_native_cv);
- cv_set_call_checker(to_unicode_cv,
+ (SV*) to_native_cv, 0);
+ cv_set_call_checker_flags(to_unicode_cv,
optimize_out_native_convert_function,
- (SV*) to_unicode_cv);
+ (SV*) to_unicode_cv, 0);
}
#endif
*cvfile = (char *)file;
Safefree(oldfile);
}
+
+ /* overload fallback flag for Regexp */
+ sv_setiv(get_sv("Regexp::()", GV_ADD), 1);
}
/*