add strbeg argument to Perl_re_intuit_start()

(note that this is a change both to the perl API and the regex engine
plugin API).

Currently, Perl_re_intuit_start() is passed an SV, plus pointers to:
where in the string to start matching (strpos); and to the end of the
string (strend).

Unlike Perl_regexec_flags(), it doesn't also have a strbeg arg.
Because of this this, it guesses strbeg: based on the passed SV (if its
svPOK()); or just set to strpos otherwise. This latter can happen if for
example the SV is overloaded. Note also that this latter guess is wrong,
and could in theory make /\b.../ fail.

But just to confuse matters, although Perl_re_intuit_start() itself uses
its guesstimate strbeg var, some of the functions it calls use the global
value of PL_bostr instead. To make this work, the *callers* of
Perl_re_intuit_start() currently set PL_bostr first. This is why \b
doesn't actually break.

The fix to this unholy mess is to simply add a strbeg arg to
Perl_re_intuit_start(). It's also the first step to eliminating PL_bostr
altogether.

diff --git a/embed.fnc b/embed.fnc
index b8f85a4..b17ea71 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1107,8 +1107,12 @@ p        |REGEXP*|re_op_compile  |NULLOK SV ** const patternp \
                                |NULLOK bool *is_bare_re \
                                |U32 rx_flags|U32 pm_flags
 Ap     |REGEXP*|re_compile     |NN SV * const pattern|U32 orig_rx_flags
-Ap     |char*  |re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|NN char* strpos \
-                               |NN char* strend|const U32 flags \
+Ap     |char*  |re_intuit_start|NN REGEXP * const rx \
+                               |NULLOK SV* sv \
+                               |NN const char* const strbeg \
+                               |NN char* strpos \
+                               |NN char* strend \
+                               |const U32 flags \
                                |NULLOK re_scream_pos_data *data
 Ap     |SV*    |re_intuit_string|NN REGEXP  *const r
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C)

diff --git a/embed.h b/embed.h
index ff43e10..47b46ef 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -451,7 +451,7 @@
 #define pv_pretty(a,b,c,d,e,f,g)       Perl_pv_pretty(aTHX_ a,b,c,d,e,f,g)
 #define pv_uni_display(a,b,c,d,e)      Perl_pv_uni_display(aTHX_ a,b,c,d,e)
 #define re_compile(a,b)                Perl_re_compile(aTHX_ a,b)
-#define re_intuit_start(a,b,c,d,e,f)   Perl_re_intuit_start(aTHX_ a,b,c,d,e,f)
+#define re_intuit_start(a,b,c,d,e,f,g) Perl_re_intuit_start(aTHX_ a,b,c,d,e,f,g)
 #define re_intuit_string(a)    Perl_re_intuit_string(aTHX_ a)
 #define reentrant_free()       Perl_reentrant_free(aTHX)
 #define reentrant_init()       Perl_reentrant_init(aTHX)

diff --git a/ext/re/re.pm b/ext/re/re.pm
index 6e9e9b0..ebad00a 100644 (file)
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -4,7 +4,7 @@ package re;
 use strict;
 use warnings;
 
-our $VERSION     = "0.24";
+our $VERSION     = "0.25";
 our @ISA         = qw(Exporter);
 our @EXPORT_OK   = ('regmust',
                     qw(is_regexp regexp_pattern

diff --git a/ext/re/re.xs b/ext/re/re.xs
index 1da68f1..93a3b9c 100644 (file)
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -20,9 +20,15 @@ extern I32   my_regexec (pTHX_ REGEXP * const prog, char* stringarg, char* strend,
                            char* strbeg, I32 minend, SV* screamer,
                            void* data, U32 flags);
 
-extern char*   my_re_intuit_start (pTHX_ REGEXP * const prog, SV *sv, char *strpos,
-                                   char *strend, const U32 flags,
-                                   struct re_scream_pos_data_s *data);
+extern char*   my_re_intuit_start(pTHX_
+                    REGEXP * const rx,
+                    SV *sv,
+                    const char * const strbeg,
+                    char *strpos,
+                    char *strend,
+                    const U32 flags,
+                    re_scream_pos_data *data);
+
 extern SV*     my_re_intuit_string (pTHX_ REGEXP * const prog);
 
 extern void    my_regfree (pTHX_ REGEXP * const r);

diff --git a/perl.h b/perl.h
index 702cfb8..613fd3c 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -224,8 +224,8 @@
 #define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
     RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \
         (strbeg),(minend),(screamer),(data),(flags))
-#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \
-    RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strpos), \
+#define CALLREG_INTUIT_START(prog,sv,strbeg,strpos,strend,flags,data) \
+    RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strbeg), (strpos), \
         (strend),(flags),(data))
 #define CALLREG_INTUIT_STRING(prog) \
     RX_ENGINE(prog)->checkstr(aTHX_ (prog))

diff --git a/pod/perlreapi.pod b/pod/perlreapi.pod
index 3d0962a..c4e30cb 100644 (file)
--- a/pod/perlreapi.pod
+++ b/pod/perlreapi.pod
@@ -21,6 +21,7 @@ following format:
                          void* data, U32 flags);
         char*   (*intuit) (pTHX_
                            REGEXP * const rx, SV *sv,
+                          const char * const strbeg,
                            char *strpos, char *strend, U32 flags,
                            struct re_scream_pos_data_s *data);
         SV*     (*checkstr) (pTHX_ REGEXP * const rx);
@@ -286,9 +287,14 @@ Optimisation flags; subject to change.
 
 =head2 intuit
 
-    char* intuit(pTHX_ REGEXP * const rx,
-                  SV *sv, char *strpos, char *strend,
-                  const U32 flags, struct re_scream_pos_data_s *data);
+    char* intuit(pTHX_
+               REGEXP * const rx,
+               SV *sv,
+               const char * const strbeg,
+               char *strpos,
+               char *strend,
+               const U32 flags,
+               struct re_scream_pos_data_s *data);
 
 Find the start position where a regex match should be attempted,
 or possibly if the regex engine should not be run because the
@@ -296,6 +302,21 @@ pattern can't match.  This is called, as appropriate, by the core,
 depending on the values of the C<extflags> member of the C<regexp>
 structure.
 
+Arguments:
+
+    rx:     the regex to match against
+    sv:     the SV being matched: only used for utf8 flag; the string
+           itself is accessed via the pointers below. Note that on
+           something like an overloaded SV, SvPOK(sv) may be false
+           and the string pointers may point to something unrelated to
+           the SV itself.
+    strbeg: real beginning of string
+    strpos: the point in the string at which to begin matching
+    strend: pointer to the byte following the last char of the string
+    flags   currently unused; set to 0
+    data:   currently unused; set to NULL
+
+
 =head2 checkstr
 
     SV*        checkstr(pTHX_ REGEXP * const rx);

diff --git a/pp_hot.c b/pp_hot.c
index 157c469..f91727e 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1438,9 +1438,8 @@ PP(pp_match)
     }
     if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT &&
        DO_UTF8(TARG) == (RX_UTF8(rx) != 0)) {
-       /* FIXME - can PL_bostr be made const char *?  */
-       PL_bostr = (char *)truebase;
-       s = CALLREG_INTUIT_START(rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
+       s = CALLREG_INTUIT_START(rx, TARG, truebase,
+                        (char *)s, (char *)strend, r_flags, NULL);
 
        if (!s)
            goto nope;
@@ -2256,8 +2255,7 @@ PP(pp_subst)
 
     orig = m = s;
     if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
-       PL_bostr = orig;
-       s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
+       s = CALLREG_INTUIT_START(rx, TARG, orig, s, strend, r_flags, NULL);
 
        if (!s)
            goto ret_no;

diff --git a/proto.h b/proto.h
index 806b56c..cc94108 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3252,12 +3252,13 @@ PERL_CALLCONV REGEXP*   Perl_re_compile(pTHX_ SV * const pattern, U32 orig_rx_flag
 #define PERL_ARGS_ASSERT_RE_COMPILE    \
        assert(pattern)
 
-PERL_CALLCONV char*    Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV* sv, char* strpos, char* strend, const U32 flags, re_scream_pos_data *data)
+PERL_CALLCONV char*    Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV* sv, const char* const strbeg, char* strpos, char* strend, const U32 flags, re_scream_pos_data *data)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_3)
-                       __attribute__nonnull__(pTHX_4);
+                       __attribute__nonnull__(pTHX_4)
+                       __attribute__nonnull__(pTHX_5);
 #define PERL_ARGS_ASSERT_RE_INTUIT_START       \
-       assert(rx); assert(strpos); assert(strend)
+       assert(rx); assert(strbeg); assert(strpos); assert(strend)
 
 PERL_CALLCONV SV*      Perl_re_intuit_string(pTHX_ REGEXP  *const r)
                        __attribute__nonnull__(pTHX_1);

diff --git a/regexec.c b/regexec.c
index 0b73c72..6e2bf9b 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -588,9 +588,29 @@ Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend,
    The nodes of the REx which we used for the search should have been
    deleted from the finite automaton. */
 
+/* args:
+ * rx:     the regex to match against
+ * sv:     the SV being matched: only used for utf8 flag; the string
+ *         itself is accessed via the pointers below. Note that on
+ *         something like an overloaded SV, SvPOK(sv) may be false
+ *         and the string pointers may point to something unrelated to
+ *         the SV itself.
+ * strbeg: real beginning of string
+ * strpos: the point in the string at which to begin matching
+ * strend: pointer to the byte following the last char of the string
+ * flags   currently unused; set to 0
+ * data:   currently unused; set to NULL
+ */
+
 char *
-Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
-                    char *strend, const U32 flags, re_scream_pos_data *data)
+Perl_re_intuit_start(pTHX_
+                    REGEXP * const rx,
+                    SV *sv,
+                    const char * const strbeg,
+                    char *strpos,
+                    char *strend,
+                    const U32 flags,
+                    re_scream_pos_data *data)
 {
     dVAR;
     struct regexp *const prog = ReANY(rx);
@@ -599,7 +619,6 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
     I32 end_shift   = 0;
     char *s;
     SV *check;
-    char *strbeg;
     char *t;
     const bool utf8_target = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
     I32 ml_anch;
@@ -624,12 +643,6 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
 
     is_utf8_pat = cBOOL(RX_UTF8(rx));
 
-    DEBUG_EXECUTE_r( 
-        debug_start_match(rx, utf8_target, strpos, strend,
-            sv ? "Guessing start of match in sv for"
-               : "Guessing start of match in string for");
-             );
-
     /* CHR_DIST() would be more correct here but it makes things slow. */
     if (prog->minlen > strend - strpos) {
        DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
@@ -637,20 +650,7 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
        goto fail;
     }
 
-    /* XXX we need to pass strbeg as a separate arg: the following is
-     * guesswork and can be wrong... */
-    if (sv && SvPOK(sv)) {
-        char * p   = SvPVX(sv);
-        STRLEN cur = SvCUR(sv); 
-        if (p <= strpos && strpos < p + cur) {
-            strbeg = p;
-            assert(p <= strend && strend <= p + cur);
-        }
-        else
-            strbeg = strend - cur;
-    }
-    else 
-        strbeg = strpos;
+    PL_bostr = (char *)strbeg;
 
     reginfo->strend = strend;
     reginfo->is_utf8_pat = is_utf8_pat;
@@ -676,8 +676,6 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
        if (!ml_anch) {
          if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
                && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
-              /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
-              && sv && !SvROK(sv)
               && (strpos != strbeg)) {
              DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
              goto fail;
@@ -1051,8 +1049,7 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
       try_at_start:
        /* Even in this situation we may use MBOL flag if strpos is offset
           wrt the start of the string. */
-       if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
-           && (strpos != strbeg) && strpos[-1] != '\n'
+       if (ml_anch && (strpos != strbeg) && strpos[-1] != '\n'
            /* May be due to an implicit anchor of m{.*foo}  */
            && !(prog->intflags & PREGf_IMPLICIT))
        {
@@ -2194,7 +2191,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
 
        d.scream_olds = &scream_olds;
        d.scream_pos = &scream_pos;
-       s = re_intuit_start(rx, sv, s, strend, flags, &d);
+       s = re_intuit_start(rx, sv, strbeg, s, strend, flags, &d);
        if (!s) {
            DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
            goto phooey;        /* not present */
@@ -2232,7 +2229,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
                             goto phooey;
                         }
                         if (prog->extflags & RXf_USE_INTUIT) {
-                            s = re_intuit_start(rx, sv, s + UTF8SKIP(s), strend, flags, NULL);
+                            s = re_intuit_start(rx, sv, strbeg,
+                                    s + UTF8SKIP(s), strend, flags, NULL);
                             if (!s) {
                                 goto phooey;
                             }
@@ -2255,7 +2253,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
                             goto phooey;
                         }
                         if (prog->extflags & RXf_USE_INTUIT) {
-                            s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
+                            s = re_intuit_start(rx, sv, strbeg,
+                                        s + 1, strend, flags, NULL);
                             if (!s) {
                                 goto phooey;
                             }

diff --git a/regexp.h b/regexp.h
index 3479f26..72d2339 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -157,8 +157,13 @@ typedef struct regexp_engine {
     I32     (*exec) (pTHX_ REGEXP * const rx, char* stringarg, char* strend,
                      char* strbeg, I32 minend, SV* screamer,
                      void* data, U32 flags);
-    char*   (*intuit) (pTHX_ REGEXP * const rx, SV *sv, char *strpos,
-                       char *strend, const U32 flags,
+    char*   (*intuit) (pTHX_
+                        REGEXP * const rx,
+                        SV *sv,
+                        const char * const strbeg,
+                        char *strpos,
+                        char *strend,
+                        const U32 flags,
                        re_scream_pos_data *data);
     SV*     (*checkstr) (pTHX_ REGEXP * const rx);
     void    (*free) (pTHX_ REGEXP * const rx);