[PATCH 5.7.0] make regcomp reenterable
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 33f91ee..fce163f 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -211,6 +211,21 @@ PP(pp_substcont)
     cx->sb_m = m = rx->startp[0] + orig;
     sv_catpvn(dstr, s, m-s);
     cx->sb_s = rx->endp[0] + orig;
+    { /* Update the pos() information. */
+       SV *sv = cx->sb_targ;
+       MAGIC *mg;
+       I32 i;
+       if (SvTYPE(sv) < SVt_PVMG)
+           SvUPGRADE(sv, SVt_PVMG);
+       if (!(mg = mg_find(sv, 'g'))) {
+           sv_magic(sv, Nullsv, 'g', Nullch, 0);
+           mg = mg_find(sv, 'g');
+       }
+       i = m - orig;
+       if (DO_UTF8(sv))
+           sv_pos_b2u(sv, &i);
+       mg->mg_len = i;
+    }
     cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
     rxres_save(&cx->sb_rxres, rx);
     RETURNOP(pm->op_pmreplstart);
@@ -342,6 +357,7 @@ PP(pp_formline)
            case FF_MORE:       name = "MORE";          break;
            case FF_LINEMARK:   name = "LINEMARK";      break;
            case FF_END:        name = "END";           break;
+            case FF_0DECIMAL:  name = "0DECIMAL";      break;
            }
            if (arg >= 0)
                PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg);
@@ -620,6 +636,43 @@ PP(pp_formline)
            t += fieldsize;
            break;
 
+       case FF_0DECIMAL:
+           /* If the field is marked with ^ and the value is undefined,
+              blank it out. */
+           arg = *fpc++;
+           if ((arg & 512) && !SvOK(sv)) {
+               arg = fieldsize;
+               while (arg--)
+                   *t++ = ' ';
+               break;
+           }
+           gotsome = TRUE;
+           value = SvNV(sv);
+           /* Formats aren't yet marked for locales, so assume "yes". */
+           {
+               STORE_NUMERIC_STANDARD_SET_LOCAL();
+#if defined(USE_LONG_DOUBLE)
+               if (arg & 256) {
+                   sprintf(t, "%#0*.*" PERL_PRIfldbl,
+                           (int) fieldsize, (int) arg & 255, value); 
+/* is this legal? I don't have long doubles */      
+               } else {
+                   sprintf(t, "%0*.0" PERL_PRIfldbl, (int) fieldsize, value);
+               }
+#else
+               if (arg & 256) {
+                   sprintf(t, "%#0*.*f",
+                           (int) fieldsize, (int) arg & 255, value);
+               } else {
+                   sprintf(t, "%0*.0f",
+                           (int) fieldsize, value);
+               }
+#endif
+               RESTORE_NUMERIC_STANDARD();
+           }
+           t += fieldsize;
+           break;
+           
        case FF_NEWLINE:
            f++;
            while (t-- > linemark && *t == ' ') ;
@@ -2975,13 +3028,13 @@ PP(pp_require)
            U8 *s = (U8*)SvPVX(sv);
            U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
            if (s < end) {
-               rev = utf8_to_uv_chk(s, end - s, &len, 0);
+               rev = utf8_to_uv(s, end - s, &len, 0);
                s += len;
                if (s < end) {
-                   ver = utf8_to_uv_chk(s, end - s, &len, 0);
+                   ver = utf8_to_uv(s, end - s, &len, 0);
                    s += len;
                    if (s < end)
-                       sver = utf8_to_uv_chk(s, end - s, &len, 0);
+                       sver = utf8_to_uv(s, end - s, &len, 0);
                }
            }
            if (PERL_REVISION < rev
@@ -3632,6 +3685,24 @@ S_doparseform(pTHX_ SV *sv)
                }
                *fpc++ = s - base;              /* fieldsize for FETCH */
                *fpc++ = FF_DECIMAL;
+                *fpc++ = arg;
+            }
+            else if (*s == '0' && s[1] == '#') {  /* Zero padded decimals */
+                arg = ischop ? 512 : 0;
+               base = s - 1;
+                s++;                                /* skip the '0' first */
+                while (*s == '#')
+                    s++;
+                if (*s == '.') {
+                    char *f;
+                    s++;
+                    f = s;
+                    while (*s == '#')
+                        s++;
+                    arg |= 256 + (s - f);
+                }
+                *fpc++ = s - base;                /* fieldsize for FETCH */
+                *fpc++ = FF_0DECIMAL;
                *fpc++ = arg;
            }
            else {