This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5171delta: typo
[perl5.git] / regcomp.c
index a962d2d..acecaa9 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5383,6 +5383,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
            OP *o = NULL;
            int n = 0;
            bool utf8 = 0;
+            STRLEN orig_patlen = 0;
 
            if (pRExC_state->num_code_blocks) {
                o = cLISTOPx(expr)->op_first;
@@ -5424,11 +5425,36 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                    o = o->op_sibling;;
                }
 
+               if ((SvAMAGIC(pat) || SvAMAGIC(msv)) &&
+                       (sv = amagic_call(pat, msv, concat_amg, AMGf_assign)))
+               {
+                   sv_setsv(pat, sv);
+                   /* overloading involved: all bets are off over literal
+                    * code. Pretend we haven't seen it */
+                   pRExC_state->num_code_blocks -= n;
+                   n = 0;
+                    rx = NULL;
+
+               }
+               else  {
+                    while (SvAMAGIC(msv)
+                            && (sv = AMG_CALLunary(msv, string_amg))
+                            && sv != msv)
+                    {
+                        msv = sv;
+                        SvGETMAGIC(msv);
+                    }
+                    if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP)
+                        msv = SvRV(msv);
+                    orig_patlen = SvCUR(pat);
+                    sv_catsv_nomg(pat, msv);
+                    rx = msv;
+                    if (code)
+                        pRExC_state->code_blocks[n-1].end = SvCUR(pat)-1;
+                }
+
                /* extract any code blocks within any embedded qr//'s */
-               rx = msv;
-               if (SvROK(rx))
-                   rx = SvRV(rx);
-               if (SvTYPE(rx) == SVt_REGEXP
+               if (rx && SvTYPE(rx) == SVt_REGEXP
                    && RX_ENGINE((REGEXP*)rx)->op_comp)
                {
 
@@ -5446,7 +5472,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                        pRExC_state->num_code_blocks += ri->num_code_blocks;
                        for (i=0; i < ri->num_code_blocks; i++) {
                            struct reg_code_block *src, *dst;
-                           STRLEN offset =  SvCUR(pat)
+                           STRLEN offset =  orig_patlen
                                + ((struct regexp *)SvANY(rx))->pre_prefix;
                            assert(n < pRExC_state->num_code_blocks);
                            src = &ri->code_blocks[i];
@@ -5462,29 +5488,20 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                        }
                    }
                }
-
-               if ((SvAMAGIC(pat) || SvAMAGIC(msv)) &&
-                       (sv = amagic_call(pat, msv, concat_amg, AMGf_assign)))
-               {
-                   sv_setsv(pat, sv);
-                   /* overloading involved: all bets are off over literal
-                    * code. Pretend we haven't seen it */
-                   pRExC_state->num_code_blocks -= n;
-                   n = 0;
-
-               }
-               else {
-                   if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP)
-                       msv = SvRV(msv);
-                   sv_catsv_nomg(pat, msv);
-                   if (code)
-                       pRExC_state->code_blocks[n-1].end = SvCUR(pat)-1;
-               }
            }
            SvSETMAGIC(pat);
        }
-       else
+       else {
+            SV *sv;
            pat = *patternp;
+            while (SvAMAGIC(pat)
+                    && (sv = AMG_CALLunary(pat, string_amg))
+                    && sv != pat)
+            {
+                pat = sv;
+                SvGETMAGIC(pat);
+            }
+        }
 
        /* handle bare regex: foo =~ $re */
        {
@@ -10417,38 +10434,39 @@ tryagain:
                            break;
                        }
                    case 'x':
-                       if (*++p == '{') {
-                           char* const e = strchr(p, '}');
+                       {
+                           STRLEN brace_len = len;
+                           UV result;
+                           const char* error_msg;
 
-                           if (!e) {
-                               RExC_parse = p + 1;
-                               vFAIL("Missing right brace on \\x{}");
+                           bool valid = grok_bslash_x(p,
+                                                      &result,
+                                                      &brace_len,
+                                                      &error_msg,
+                                                      1);
+                           p += brace_len;
+                           if (! valid) {
+                               RExC_parse = p; /* going to die anyway; point
+                                                  to exact spot of failure */
+                               vFAIL(error_msg);
                            }
                            else {
-                                I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
-                                    | PERL_SCAN_DISALLOW_PREFIX;
-                                STRLEN numlen = e - p - 1;
-                               ender = grok_hex(p + 1, &numlen, &flags, NULL);
-                               if (ender > 0xff)
-                                   REQUIRE_UTF8;
-                               p = e + 1;
+                               ender = result;
                            }
+                           if (PL_encoding && ender < 0x100) {
+                               goto recode_encoding;
+                           }
+                           if (ender > 0xff) {
+                               REQUIRE_UTF8;
+                           }
+                           break;
                        }
-                       else {
-                            I32 flags = PERL_SCAN_DISALLOW_PREFIX;
-                           STRLEN numlen = 2;
-                           ender = grok_hex(p, &numlen, &flags, NULL);
-                           p += numlen;
-                       }
-                       if (PL_encoding && ender < 0x100)
-                           goto recode_encoding;
-                       break;
                    case 'c':
                        p++;
                        ender = grok_bslash_c(*p++, UTF, SIZE_ONLY);
                        break;
                    case '0': case '1': case '2': case '3':case '4':
-                   case '5': case '6': case '7': case '8':case '9':
+                   case '5': case '6': case '7':
                        if (*p == '0' ||
                            (isDIGIT(p[1]) && atoi(p) >= RExC_npar))
                        {
@@ -10481,7 +10499,7 @@ tryagain:
                            FAIL("Trailing \\");
                        /* FALL THROUGH */
                    default:
-                       if (!SIZE_ONLY&& isALPHA(*p)) {
+                       if (!SIZE_ONLY&& isALNUMC(*p)) {
                            ckWARN2reg(p + 1, "Unrecognized escape \\%.1s passed through", p);
                        }
                        goto normal_default;
@@ -11525,22 +11543,18 @@ parseit:
                }
                break;
            case 'x':
-               if (*RExC_parse == '{') {
-                    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
-                        | PERL_SCAN_DISALLOW_PREFIX;
-                   char * const e = strchr(RExC_parse++, '}');
-                    if (!e)
-                        vFAIL("Missing right brace on \\x{}");
-
-                   numlen = e - RExC_parse;
-                   value = grok_hex(RExC_parse, &numlen, &flags, NULL);
-                   RExC_parse = e + 1;
-               }
-               else {
-                    I32 flags = PERL_SCAN_DISALLOW_PREFIX;
-                   numlen = 2;
-                   value = grok_hex(RExC_parse, &numlen, &flags, NULL);
+               RExC_parse--;   /* function expects to be pointed at the 'x' */
+               {
+                   const char* error_msg;
+                   bool valid = grok_bslash_x(RExC_parse,
+                                              &value,
+                                              &numlen,
+                                              &error_msg,
+                                              1);
                    RExC_parse += numlen;
+                   if (! valid) {
+                       vFAIL(error_msg);
+                   }
                }
                if (PL_encoding && value < 0x100)
                    goto recode_encoding;