This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert 4 regex commits to ease rebasing
authorDavid Mitchell <davem@iabyn.com>
Sun, 30 Oct 2011 16:12:02 +0000 (16:12 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 13 Jun 2012 12:25:48 +0000 (13:25 +0100)
Revert "Remove some repeated code in pp_regcomp"
This reverts commit 3e1022372a8200bc4c7354e0f588c7f71584a888.

Revert "regcomp.c: Use no_mg for 2nd fetch of pattern"
This reverts commit 3e0b93e82af0f1a033bcdb918b413113f1d61cf0.
`
Revert "PATCH: [perl #101940]: BBC Tk"
This reverts commit 11951bcbfcaf4c260b0da0421e72fc80b4654f17.

Revert "Fix =~ $str_overloaded (5.10 regression)"
This reverts commit 15d9c083b08647e489d279a1059b4f14a3df187b.

These four recent commits on the blead branch overlap with work on the
re_eval branch. To make rebasing re_eval easier, revert them at the
beginning of the re_eval branch. Any remaining value will be re-added
later in the re_eval branch.

lib/overload.t
pp_ctl.c
regcomp.c

index 5d6e38d..4be1260 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5037;
+plan tests => 4983;
 
 use Scalar::Util qw(tainted);
 
@@ -1793,8 +1793,6 @@ foreach my $op (qw(<=> == != < <= > >=)) {
        # note: this is testing unary qr, not binary =~
        $subs{qr} = '(qr/%s/)';
        push @tests, [ "abc", '"abc" =~ (%s)', '(qr)', '("")', [ 1, 2, 0 ], 0 ];
-       push @tests, [ chr 256, 'chr(256) =~ (%s)', '(qr)', '("")',
-                                                         [ 1, 2, 0 ], 0 ];
 
        $e = '"abc" ~~ (%s)';
        $subs{'~~'} = $e;
index 669fb27..2cde665 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -205,7 +205,9 @@ PP(pp_regcomp)
            if (PL_op->op_flags & OPf_SPECIAL)
                PL_reginterp_cnt = I32_MAX; /* Mark as safe.  */
 
-           if (!DO_UTF8(tmpstr) && SvUTF8(tmpstr)) {
+           if (DO_UTF8(tmpstr)) {
+               assert (SvUTF8(tmpstr));
+           } else if (SvUTF8(tmpstr)) {
                /* Not doing UTF-8, despite what the SV says. Is this only if
                   we're trapped in use 'bytes'?  */
                /* Make a copy of the octet sequence, but without the flag on,
@@ -214,11 +216,19 @@ PP(pp_regcomp)
                const char *const p = SvPV(tmpstr, len);
                tmpstr = newSVpvn_flags(p, len, SVs_TEMP);
            }
-           else if (SvAMAGIC(tmpstr) || SvGMAGICAL(tmpstr)) {
+           else if (SvAMAGIC(tmpstr)) {
                /* make a copy to avoid extra stringifies */
                tmpstr = newSVpvn_flags(t, len, SVs_TEMP | SvUTF8(tmpstr));
            }
 
+           /* If it is gmagical, create a mortal copy, but without calling
+              get-magic, as we have already done that. */
+           if(SvGMAGICAL(tmpstr)) {
+               SV *mortalcopy = sv_newmortal();
+               sv_setsv_flags(mortalcopy, tmpstr, 0);
+               tmpstr = mortalcopy;
+           }
+
            if (eng)
                PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
            else
index 4421d37..6bcd8b7 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5034,14 +5034,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     }
 #endif
 
-    exp = SvPV(pattern, plen);
-
-    if (plen == 0) { /* ignore the utf8ness if the pattern is 0 length */
-       RExC_utf8 = RExC_orig_utf8 = 0;
-    }
-    else {
-       RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
-    }
+    RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
     RExC_uni_semantics = 0;
     RExC_contains_locale = 0;
 
@@ -5053,7 +5046,12 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     }
 
     if (jump_ret == 0) {    /* First time through */
+       exp = SvPV(pattern, plen);
        xend = exp + plen;
+       /* ignore the utf8ness if the pattern is 0 length */
+       if (plen == 0) {
+           RExC_utf8 = RExC_orig_utf8 = 0;
+       }
 
         DEBUG_COMPILE_r({
             SV *dsv= sv_newmortal();
@@ -5085,9 +5083,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
         -- dmq */
         DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log,
            "UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
-        exp = (char*)Perl_bytes_to_utf8(aTHX_
-                                       (U8*)SvPV_nomg(pattern, plen),
-                                       &len);
+        exp = (char*)Perl_bytes_to_utf8(aTHX_ (U8*)SvPV(pattern, plen), &len);
         xend = exp + len;
         RExC_orig_utf8 = RExC_utf8 = 1;
         SAVEFREEPV(exp);