#define PERL_IN_REGEXEC_C
#include "perl.h"
-#ifdef PERL_IN_XSUB_RE
-# if defined(PERL_CAPI) || defined(PERL_OBJECT)
-# include "XSUB.h"
-# endif
-#endif
-
#include "regcomp.h"
#define RF_tainted 1 /* tainted information used? */
*/
#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
-#define CHR_DIST(a,b) (PL_reg_sv_utf8 ? utf8_distance(a,b) : a - b)
+#define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
#define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
#define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
-#define HOP(pos,off) (PL_reg_sv_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
-#define HOPMAYBE(pos,off) (PL_reg_sv_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
+#define HOP(pos,off) (PL_reg_match_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
+#define HOPMAYBE(pos,off) (PL_reg_match_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
#define HOPc(pos,off) ((char*)HOP(pos,off))
#define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
#define HOPBACK(pos, off) ( \
- (UTF && PL_reg_sv_utf8) \
+ (UTF && PL_reg_match_utf8) \
? reghopmaybe((U8*)pos, -off) \
: (pos - off >= PL_bostr) \
? (U8*)(pos - off) \
#define reghop3_c(pos,off,lim) ((char*)reghop3((U8*)pos, off, (U8*)lim))
#define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
-#define HOP3(pos,off,lim) (PL_reg_sv_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
-#define HOPMAYBE3(pos,off,lim) (PL_reg_sv_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
+#define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
+#define HOPMAYBE3(pos,off,lim) (PL_reg_match_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
#define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
#define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
#define LOAD_UTF8_CHARCLASS(a,b) STMT_START { if (!CAT2(PL_utf8_,a)) (void)CAT2(is_utf8_, a)((U8*)b); } STMT_END
-static void restore_pos(pTHXo_ void *arg);
+/* for use after a quantifier and before an EXACT-like node -- japhy */
+#define NEXT_IMPT(to_rn) STMT_START { \
+ while (OP(to_rn) == OPEN || OP(to_rn) == CLOSE || OP(to_rn) == EVAL) \
+ to_rn += NEXT_OFF(to_rn); \
+} STMT_END
+
+static void restore_pos(pTHX_ void *arg);
STATIC CHECKPOINT
S_regcppush(pTHX_ I32 parenfloor)
unsigned int c2;
char *e;
register I32 tmp = 1; /* Scratch variable? */
- register bool do_utf8 = PL_reg_sv_utf8;
+ register bool do_utf8 = PL_reg_match_utf8;
/* We know what class it must start with. */
switch (OP(c)) {
sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
restored, the value remains
the same. */
- restore_pos(aTHXo_ 0);
+ restore_pos(aTHX_ 0);
}
/* make sure $`, $&, $', and $digit will work later */
DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
PL_colors[4],PL_colors[5]));
if (PL_reg_eval_set)
- restore_pos(aTHXo_ 0);
+ restore_pos(aTHX_ 0);
return 0;
}
#if 0
I32 firstcp = PL_savestack_ix;
#endif
- register bool do_utf8 = PL_reg_sv_utf8;
+ register bool do_utf8 = PL_reg_match_utf8;
#ifdef DEBUGGING
PL_regindent++;
if (ln && l == 0)
n = ln; /* don't backtrack */
locinput = PL_reginput;
- if (PL_regkind[(U8)OP(next)] == EXACT) {
- c1 = (U8)*STRING(next);
- if (OP(next) == EXACTF)
- c2 = PL_fold[c1];
- else if (OP(next) == EXACTFL)
- c2 = PL_fold_locale[c1];
- else
- c2 = c1;
+ if (
+ PL_regkind[(U8)OP(next)] == EXACT ||
+ OP(next) == OPEN ||
+ OP(next) == CLOSE ||
+ OP(next) == EVAL
+ ) {
+ regnode *text_node = next;
+
+ if (PL_regkind[(U8)OP(next)] != EXACT)
+ NEXT_IMPT(text_node);
+
+ if (PL_regkind[(U8)OP(text_node)] != EXACT) {
+ c1 = c2 = -1000;
+ }
+ else {
+ c1 = (U8)*STRING(text_node);
+ if (OP(next) == EXACTF)
+ c2 = PL_fold[c1];
+ else if (OP(text_node) == EXACTFL)
+ c2 = PL_fold_locale[c1];
+ else
+ c2 = c1;
+ }
}
else
c1 = c2 = -1000;
(IV) n, (IV)l)
);
if (n >= ln) {
- if (PL_regkind[(U8)OP(next)] == EXACT) {
- c1 = (U8)*STRING(next);
- if (OP(next) == EXACTF)
- c2 = PL_fold[c1];
- else if (OP(next) == EXACTFL)
- c2 = PL_fold_locale[c1];
- else
- c2 = c1;
+ if (
+ PL_regkind[(U8)OP(next)] == EXACT ||
+ OP(next) == OPEN ||
+ OP(next) == CLOSE ||
+ OP(next) == EVAL
+ ) {
+ regnode *text_node = next;
+
+ if (PL_regkind[(U8)OP(next)] != EXACT)
+ NEXT_IMPT(text_node);
+
+ if (PL_regkind[(U8)OP(text_node)] != EXACT) {
+ c1 = c2 = -1000;
+ }
+ else {
+ c1 = (U8)*STRING(text_node);
+ if (OP(text_node) == EXACTF)
+ c2 = PL_fold[c1];
+ else if (OP(text_node) == EXACTFL)
+ c2 = PL_fold_locale[c1];
+ else
+ c2 = c1;
+ }
}
else
c1 = c2 = -1000;
* Lookahead to avoid useless match attempts
* when we know what character comes next.
*/
- if (PL_regkind[(U8)OP(next)] == EXACT) {
- U8 *s = (U8*)STRING(next);
- if (!UTF) {
- c2 = c1 = *s;
- if (OP(next) == EXACTF)
- c2 = PL_fold[c1];
- else if (OP(next) == EXACTFL)
- c2 = PL_fold_locale[c1];
- }
- else { /* UTF */
- if (OP(next) == EXACTF) {
- c1 = to_utf8_lower(s);
- c2 = to_utf8_upper(s);
+
+ /*
+ * Used to only do .*x and .*?x, but now it allows
+ * for )'s, ('s and (?{ ... })'s to be in the way
+ * of the quantifier and the EXACT-like node. -- japhy
+ */
+
+ if (
+ PL_regkind[(U8)OP(next)] == EXACT ||
+ OP(next) == OPEN ||
+ OP(next) == CLOSE ||
+ OP(next) == EVAL
+ ) {
+ U8 *s;
+ regnode *text_node = next;
+
+ if (PL_regkind[(U8)OP(next)] != EXACT)
+ NEXT_IMPT(text_node);
+
+ if (PL_regkind[(U8)OP(text_node)] != EXACT) {
+ c1 = c2 = -1000;
+ }
+ else {
+ s = (U8*)STRING(text_node);
+
+ if (!UTF) {
+ c2 = c1 = *s;
+ if (OP(text_node) == EXACTF)
+ c2 = PL_fold[c1];
+ else if (OP(text_node) == EXACTFL)
+ c2 = PL_fold_locale[c1];
}
- else {
- c2 = c1 = utf8_to_uvchr(s, NULL);
+ else { /* UTF */
+ if (OP(text_node) == EXACTF) {
+ c1 = to_utf8_lower(s);
+ c2 = to_utf8_upper(s);
+ }
+ else {
+ c2 = c1 = utf8_to_uvchr(s, NULL);
+ }
}
}
}
register I32 c;
register char *loceol = PL_regeol;
register I32 hardcount = 0;
- register bool do_utf8 = PL_reg_sv_utf8;
+ register bool do_utf8 = PL_reg_match_utf8;
scan = PL_reginput;
if (max != REG_INFTY && max < loceol - scan)
return 0;
start = PL_reginput;
- if (PL_reg_sv_utf8) {
+ if (PL_reg_match_utf8) {
while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
if (!count++) {
l = 0;
return s;
}
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
static void
-restore_pos(pTHXo_ void *arg)
+restore_pos(pTHX_ void *arg)
{
if (PL_reg_eval_set) {
if (PL_reg_oldsaved) {
projects / p5sagit/p5-mst-13.2.git / blobdiff