This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In t/op/filetest.t, use the tempfile instead of t/TEST in two tests.
[perl5.git] / regexec.c
index ea4810d..084b496 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -569,6 +569,8 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
     GET_RE_DEBUG_FLAGS_DECL;
 
     PERL_ARGS_ASSERT_RE_INTUIT_START;
+    PERL_UNUSED_ARG(flags);
+    PERL_UNUSED_ARG(data);
 
     RX_MATCH_UTF8_set(rx,utf8_target);
 
@@ -687,6 +689,8 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
     {
         I32 srch_start_shift = start_shift;
         I32 srch_end_shift = end_shift;
+        U8* start_point;
+        U8* end_point;
         if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
            srch_end_shift -= ((strbeg - s) - srch_start_shift); 
            srch_start_shift = strbeg - s;
@@ -699,42 +703,6 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
             (IV)prog->check_end_shift);
     });       
         
-    if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
-       I32 p = -1;                     /* Internal iterator of scream. */
-       I32 * const pp = data ? data->scream_pos : &p;
-       const MAGIC *mg;
-       bool found = FALSE;
-
-       assert(SvMAGICAL(sv));
-       mg = mg_find(sv, PERL_MAGIC_study);
-       assert(mg);
-
-       if (mg->mg_private == 1) {
-           found = ((U8 *)mg->mg_ptr)[BmRARE(check)] != (U8)~0;
-       } else if (mg->mg_private == 2) {
-           found = ((U16 *)mg->mg_ptr)[BmRARE(check)] != (U16)~0;
-       } else {
-           assert (mg->mg_private == 4);
-           found = ((U32 *)mg->mg_ptr)[BmRARE(check)] != (U32)~0;
-       }
-
-       if (found
-           || ( BmRARE(check) == '\n'
-                && (BmPREVIOUS(check) == SvCUR(check) - 1)
-                && SvTAIL(check) ))
-           s = screaminstr(sv, check,
-                           srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
-       else
-           goto fail_finish;
-       /* we may be pointing at the wrong string */
-       if (s && RXp_MATCH_COPIED(prog))
-           s = strbeg + (s - SvPVX_const(sv));
-       if (data)
-           *data->scream_olds = s;
-    }
-    else {
-        U8* start_point;
-        U8* end_point;
         if (prog->extflags & RXf_CANY_SEEN) {
             start_point= (U8*)(s + srch_start_shift);
             end_point= (U8*)(strend - srch_end_shift);
@@ -752,7 +720,6 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
        s = fbm_instr( start_point, end_point,
                      check, multiline ? FBMrf_MULTILINE : 0);
     }
-    }
     /* Update the count-of-usability, remove useless subpatterns,
        unshift s.  */
 
@@ -2357,15 +2324,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
        dontbother = end_shift;
        strend = HOPc(strend, -dontbother);
        while ( (s <= last) &&
-               ((flags & REXEC_SCREAM) && SvSCREAM(sv)
-                ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
-                                   end_shift, &scream_pos, 0))
-                : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
+               (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
                                  (unsigned char*)strend, must,
-                                 multiline ? FBMrf_MULTILINE : 0))) ) {
-           /* we may be pointing at the wrong string */
-           if ((flags & REXEC_SCREAM) && RXp_MATCH_COPIED(prog))
-               s = strbeg + (s - SvPVX_const(sv));
+                                 multiline ? FBMrf_MULTILINE : 0)) ) {
            DEBUG_EXECUTE_r( did_match = 1 );
            if (HOPc(s, -back_max) > last1) {
                last1 = HOPc(s, -back_min);
@@ -2429,26 +2390,17 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
        dontbother = 0;
        if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
            /* Trim the end. */
-           char *last;
+           char *last= NULL;
            SV* float_real;
+           STRLEN len;
+           const char *little;
 
            if (!(utf8_target ? prog->float_utf8 : prog->float_substr))
                utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog);
            float_real = utf8_target ? prog->float_utf8 : prog->float_substr;
 
-           if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
-               last = screaminstr(sv, float_real, s - strbeg,
-                                  end_shift, &scream_pos, 1); /* last one */
-               if (!last)
-                   last = scream_olds; /* Only one occurrence. */
-               /* we may be pointing at the wrong string */
-               else if (RXp_MATCH_COPIED(prog))
-                   s = strbeg + (s - SvPVX_const(sv));
-           }
-           else {
-               STRLEN len;
-                const char * const little = SvPV_const(float_real, len);
-               if (SvTAIL(float_real)) {
+            little = SvPV_const(float_real, len);
+           if (SvTAIL(float_real)) {
                    /* This means that float_real contains an artificial \n on the end
                     * due to the presence of something like this: /foo$/
                     * where we can match both "foo" and "foo\n" at the end of the string.
@@ -2494,21 +2446,24 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
                        /* multiline match, so we have to search for a place where the full string is located */
                        goto find_last;
                    }
-               } else {
+           } else {
                  find_last:
                    if (len)
                        last = rninstr(s, strend, little, little + len);
                    else
                        last = strend;  /* matching "$" */
-               }
            }
-           assert(last != NULL); /* the re_debug output below suggests we need this assert() */
-           if (last == NULL) {
+           if (!last) {
+               /* at one point this block contained a comment which was probably
+                * incorrect, which said that this was a "should not happen" case.
+                * Even if it was true when it was written I am pretty sure it is
+                * not anymore, so I have removed the comment and replaced it with
+                * this one. Yves */
                DEBUG_EXECUTE_r(
                    PerlIO_printf(Perl_debug_log,
-                       "%sCan't trim the tail, match fails (should not happen)%s\n",
-                       PL_colors[4], PL_colors[5]));
-               goto phooey; /* Should not happen! */
+                       "String does not contain required substring, cannot match.\n"
+                   ));
+               goto phooey;
            }
            dontbother = strend - last + prog->float_min_offset;
        }
@@ -5286,25 +5241,12 @@ NULL
                    }
                    else { /* UTF_PATTERN */
                        if (IS_TEXTFU(text_node) || IS_TEXTF(text_node)) {
-                            STRLEN ulen1, ulen2;
-                            U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
-                            U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
+                            STRLEN ulen;
+                            U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
 
-                            to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
-                            to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
-#ifdef EBCDIC
-                            ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
-                                                   ckWARN(WARN_UTF8) ?
-                                                    0 : UTF8_ALLOW_ANY);
-                            ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
-                                                    ckWARN(WARN_UTF8) ?
-                                                    0 : UTF8_ALLOW_ANY);
-#else
-                            ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
+                            to_utf8_fold((U8*)s, tmpbuf, &ulen);
+                            ST.c1 = ST.c2 = utf8n_to_uvchr(tmpbuf, UTF8_MAXLEN, 0,
                                                    uniflags);
-                            ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
-                                                   uniflags);
-#endif
                        }
                        else {
                            ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
@@ -7122,8 +7064,8 @@ S_to_byte_substr(pTHX_ register regexp *prog)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */