add missing dTHR; notes for test failures due to small stacksize

p4raw-id: //depot/perl@1774

diff --git a/doio.c b/doio.c
index 87672ed..271218f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -187,6 +187,7 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
                TAINT_ENV();
            TAINT_PROPER("piped open");
            if (name[strlen(name)-1] == '|') {
+               dTHR;
                name[strlen(name)-1] = '\0' ;
                if (ckWARN(WARN_PIPE))
                    warner(WARN_PIPE, "Can't do bidirectional pipe");
@@ -298,6 +299,7 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
        }
     }
     if (!fp) {
+       dTHR;
        if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == '<' && strchr(name, '\n'))
            warner(WARN_NEWLINE, warn_nl, "open");
        goto say_false;
@@ -616,6 +618,7 @@ do_close(GV *gv, bool not_implicit)
     io = GvIO(gv);
     if (!io) {         /* never opened */
        if (not_implicit) {
+           dTHR;
            if (ckWARN(WARN_UNOPENED))
                warner(WARN_UNOPENED, 
                       "Close on unopened file <%s>",GvENAME(gv));
@@ -715,8 +718,11 @@ do_tell(GV *gv)
 #endif
        return PerlIO_tell(fp);
     }
-    if (ckWARN(WARN_UNOPENED))
-       warner(WARN_UNOPENED, "tell() on unopened file");
+    {
+       dTHR;
+       if (ckWARN(WARN_UNOPENED))
+           warner(WARN_UNOPENED, "tell() on unopened file");
+    }
     SETERRNO(EBADF,RMS$_IFI);
     return -1L;
 }
@@ -734,8 +740,11 @@ do_seek(GV *gv, long int pos, int whence)
 #endif
        return PerlIO_seek(fp, pos, whence) >= 0;
     }
-    if (ckWARN(WARN_UNOPENED))
-       warner(WARN_UNOPENED, "seek() on unopened file");
+    {
+       dTHR;
+       if (ckWARN(WARN_UNOPENED))
+           warner(WARN_UNOPENED, "seek() on unopened file");
+    }
     SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
 }
@@ -748,8 +757,11 @@ do_sysseek(GV *gv, long int pos, int whence)
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
        return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
-    if (ckWARN(WARN_UNOPENED))
-       warner(WARN_UNOPENED, "sysseek() on unopened file");
+    {
+       dTHR;
+       if (ckWARN(WARN_UNOPENED))
+           warner(WARN_UNOPENED, "sysseek() on unopened file");
+    }
     SETERRNO(EBADF,RMS$_IFI);
     return -1L;
 }
@@ -869,8 +881,11 @@ do_print(register SV *sv, PerlIO *fp)
     }
     switch (SvTYPE(sv)) {
     case SVt_NULL:
-       if (ckWARN(WARN_UNINITIALIZED))
-           warner(WARN_UNINITIALIZED, warn_uninit);
+       {
+           dTHR;
+           if (ckWARN(WARN_UNINITIALIZED))
+               warner(WARN_UNINITIALIZED, warn_uninit);
+       }
        return TRUE;
     case SVt_IV:
        if (SvIOK(sv)) {
@@ -1099,9 +1114,12 @@ do_exec(char *cmd)
            do_execfree();
            goto doshell;
        }
-       if (ckWARN(WARN_EXEC))
-           warner(WARN_EXEC, "Can't exec \"%s\": %s", 
-               PL_Argv[0], Strerror(errno));
+       {
+           dTHR;
+           if (ckWARN(WARN_EXEC))
+               warner(WARN_EXEC, "Can't exec \"%s\": %s", 
+                   PL_Argv[0], Strerror(errno));
+       }
     }
     do_execfree();
     return FALSE;

diff --git a/gv.c b/gv.c
index be55a02..03b90c0 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -221,6 +221,7 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
            SV* sv = *svp++;
            HV* basestash = gv_stashsv(sv, FALSE);
            if (!basestash) {
+               dTHR;           /* just for ckWARN */
                if (ckWARN(WARN_MISC))
                    warner(WARN_MISC, "Can't locate package %s for @%s::ISA",
                        SvPVX(sv), HvNAME(stash));
@@ -339,6 +340,7 @@ gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
 GV*
 gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
 {
+    dTHR;
     static char autoload[] = "AUTOLOAD";
     static STRLEN autolen = 8;
     GV* gv;

diff --git a/op.c b/op.c
index f64a59e..69c6b45 100644 (file)
--- a/op.c
+++ b/op.c
@@ -694,15 +694,16 @@ scalarkids(OP *o)
 STATIC OP *
 scalarboolean(OP *o)
 {
-    if (ckWARN(WARN_SYNTAX) &&
-       o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
+    if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
        dTHR;
-       line_t oldline = PL_curcop->cop_line;
+       if (ckWARN(WARN_SYNTAX)) {
+           line_t oldline = PL_curcop->cop_line;
 
-       if (PL_copline != NOLINE)
-           PL_curcop->cop_line = PL_copline;
-       warner(WARN_SYNTAX, "Found = in conditional, should be ==");
-       PL_curcop->cop_line = oldline;
+           if (PL_copline != NOLINE)
+               PL_curcop->cop_line = PL_copline;
+           warner(WARN_SYNTAX, "Found = in conditional, should be ==");
+           PL_curcop->cop_line = oldline;
+       }
     }
     return scalar(o);
 }
@@ -889,15 +890,18 @@ scalarvoid(OP *o)
 
     case OP_CONST:
        sv = cSVOPo->op_sv;
-       if (ckWARN(WARN_VOID)) {
-           useless = "a constant";
-           if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
-               useless = 0;
-           else if (SvPOK(sv)) {
-               if (strnEQ(SvPVX(sv), "di", 2) ||
-                   strnEQ(SvPVX(sv), "ds", 2) ||
-                   strnEQ(SvPVX(sv), "ig", 2))
-                       useless = 0;
+       {
+           dTHR;
+           if (ckWARN(WARN_VOID)) {
+               useless = "a constant";
+               if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
+                   useless = 0;
+               else if (SvPOK(sv)) {
+                   if (strnEQ(SvPVX(sv), "di", 2) ||
+                       strnEQ(SvPVX(sv), "ds", 2) ||
+                       strnEQ(SvPVX(sv), "ig", 2))
+                           useless = 0;
+               }
            }
        }
        null(o);                /* don't execute a constant */
@@ -956,8 +960,11 @@ scalarvoid(OP *o)
        }
        break;
     }
-    if (useless && ckWARN(WARN_VOID))
-       warner(WARN_VOID, "Useless use of %s in void context", useless);
+    if (useless) {
+       dTHR;
+       if (ckWARN(WARN_VOID))
+           warner(WARN_VOID, "Useless use of %s in void context", useless);
+    }
     return o;
 }
 
@@ -1465,6 +1472,7 @@ sawparens(OP *o)
 OP *
 bind_match(I32 type, OP *left, OP *right)
 {
+    dTHR;
     OP *o;
 
     if (ckWARN(WARN_UNSAFE) &&
@@ -1648,6 +1656,7 @@ localize(OP *o, I32 lex)
     if (o->op_flags & OPf_PARENS)
        list(o);
     else {
+       dTHR;
        if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
            char *s;
            for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;

diff --git a/sv.c b/sv.c
index 6f9ad54..1ec8c46 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1313,9 +1313,9 @@ sv_2iv(register SV *sv)
        if (SvPOKp(sv) && SvLEN(sv))
            return asIV(sv);
        if (!SvROK(sv)) {
-           if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
                dTHR;
-               if (!PL_localizing)
+               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
                    warner(WARN_UNINITIALIZED, warn_uninit);
            }
            return 0;
@@ -1339,8 +1339,11 @@ sv_2iv(register SV *sv)
            }
            if (SvPOKp(sv) && SvLEN(sv))
                return asIV(sv);
-           if (ckWARN(WARN_UNINITIALIZED))
-               warner(WARN_UNINITIALIZED, warn_uninit);
+           {
+               dTHR;
+               if (ckWARN(WARN_UNINITIALIZED))
+                   warner(WARN_UNINITIALIZED, warn_uninit);
+           }
            return 0;
        }
     }
@@ -1391,9 +1394,9 @@ sv_2uv(register SV *sv)
        if (SvPOKp(sv) && SvLEN(sv))
            return asUV(sv);
        if (!SvROK(sv)) {
-           if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
                dTHR;
-               if (!PL_localizing)
+               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
                    warner(WARN_UNINITIALIZED, warn_uninit);
            }
            return 0;
@@ -1414,8 +1417,11 @@ sv_2uv(register SV *sv)
            }
            if (SvPOKp(sv) && SvLEN(sv))
                return asUV(sv);
-           if (ckWARN(WARN_UNINITIALIZED))
-               warner(WARN_UNINITIALIZED, warn_uninit);
+           {
+               dTHR;
+               if (ckWARN(WARN_UNINITIALIZED))
+                   warner(WARN_UNINITIALIZED, warn_uninit);
+           }
            return 0;
        }
     }
@@ -1439,9 +1445,9 @@ sv_2uv(register SV *sv)
        SvUVX(sv) = asUV(sv);
     }
     else  {
-       if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+       if (!(SvFLAGS(sv) & SVs_PADTMP)) {
            dTHR;
-           if (!PL_localizing)
+           if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
                warner(WARN_UNINITIALIZED, warn_uninit);
        }
        return 0;
@@ -1461,6 +1467,7 @@ sv_2nv(register SV *sv)
        if (SvNOKp(sv))
            return SvNVX(sv);
        if (SvPOKp(sv) && SvLEN(sv)) {
+           dTHR;
            if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
                not_a_number(sv);
            SET_NUMERIC_STANDARD();
@@ -1469,9 +1476,9 @@ sv_2nv(register SV *sv)
        if (SvIOKp(sv))
            return (double)SvIVX(sv);
         if (!SvROK(sv)) {
-           if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
                dTHR;
-               if (!PL_localizing)
+               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
                    warner(WARN_UNINITIALIZED, warn_uninit);
            }
             return 0;
@@ -1487,6 +1494,7 @@ sv_2nv(register SV *sv)
          return (double)(unsigned long)SvRV(sv);
        }
        if (SvREADONLY(sv)) {
+           dTHR;
            if (SvPOKp(sv) && SvLEN(sv)) {
                if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
                    not_a_number(sv);
@@ -1517,6 +1525,7 @@ sv_2nv(register SV *sv)
        SvNVX(sv) = (double)SvIVX(sv);
     }
     else if (SvPOKp(sv) && SvLEN(sv)) {
+       dTHR;
        if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
            not_a_number(sv);
        SET_NUMERIC_STANDARD();
@@ -1543,8 +1552,11 @@ asIV(SV *sv)
 
     if (numtype == 1)
        return atol(SvPVX(sv));
-    if (!numtype && ckWARN(WARN_NUMERIC))
-       not_a_number(sv);
+    if (!numtype) {
+       dTHR;
+       if (ckWARN(WARN_NUMERIC))
+           not_a_number(sv);
+    }
     SET_NUMERIC_STANDARD();
     d = atof(SvPVX(sv));
     if (d < 0.0)
@@ -1562,8 +1574,11 @@ asUV(SV *sv)
     if (numtype == 1)
        return strtoul(SvPVX(sv), Null(char**), 10);
 #endif
-    if (!numtype && ckWARN(WARN_NUMERIC))
-       not_a_number(sv);
+    if (!numtype) {
+       dTHR;
+       if (ckWARN(WARN_NUMERIC))
+           not_a_number(sv);
+    }
     SET_NUMERIC_STANDARD();
     return U_V(atof(SvPVX(sv)));
 }
@@ -1677,9 +1692,9 @@ sv_2pv(register SV *sv, STRLEN *lp)
            goto tokensave;
        }
         if (!SvROK(sv)) {
-           if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
                dTHR;
-               if (!PL_localizing)
+               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
                    warner(WARN_UNINITIALIZED, warn_uninit);
            }
             *lp = 0;
@@ -1785,8 +1800,11 @@ sv_2pv(register SV *sv, STRLEN *lp)
                tsv = Nullsv;
                goto tokensave;
            }
-           if (ckWARN(WARN_UNINITIALIZED))
-               warner(WARN_UNINITIALIZED, warn_uninit);
+           {
+               dTHR;
+               if (ckWARN(WARN_UNINITIALIZED))
+                   warner(WARN_UNINITIALIZED, warn_uninit);
+           }
            *lp = 0;
            return "";
        }

diff --git a/t/pragma/warn-mg b/t/pragma/warn-mg
index 6345b30..f414cb3 100644 (file)
--- a/t/pragma/warn-mg
+++ b/t/pragma/warn-mg
@@ -16,6 +16,7 @@ No such signal: SIGFRED at - line 3.
 ########
 # mg.c
 use warning 'signal' ;
+$|=1;
 $SIG{"INT"} = "fred"; kill "INT",$$;
 EXPECT
 SIGINT handler "fred" not defined.

diff --git a/t/pragma/warn-regexec b/t/pragma/warn-regexec
index 3d9b566..5ca776f 100644 (file)
--- a/t/pragma/warn-regexec
+++ b/t/pragma/warn-regexec
@@ -12,12 +12,42 @@ __END__
 use warning 'unsafe' ;
 $_ = 'a' x (2**15+1); 
 /^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
 EXPECT
-count exceeded 32766 at - line 4.
+Complex regular subexpression recursion limit (32766) exceeded at - line 4.
 ########
 # regexec.c
 use warning 'unsafe' ;
 $_ = 'a' x (2**15+1);
 /^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
 EXPECT
 Complex regular subexpression recursion limit (32766) exceeded at - line 4.

diff --git a/toke.c b/toke.c
index 0f43034..f47fd7a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -212,6 +212,7 @@ missingterm(char *s)
 void
 deprecate(char *s)
 {
+    dTHR;
     if (ckWARN(WARN_DEPRECATED))
        warner(WARN_DEPRECATED, "Use of %s is deprecated", s);
 }
@@ -981,12 +982,15 @@ scan_const(char *start)
 
        /* (now in tr/// code again) */
 
-       if (*s & 0x80 && ckWARN(WARN_UTF8) && thisutf) {
-           (void)utf8_to_uv(s, &len);  /* could cvt latin-1 to utf8 here... */
-           if (len) {
-               while (len--)
-                   *d++ = *s++;
-               continue;
+       if (*s & 0x80 && thisutf) {
+           dTHR;                       /* only for ckWARN */
+           if (ckWARN(WARN_UTF8)) {
+               (void)utf8_to_uv(s, &len);      /* could cvt latin-1 to utf8 here... */
+               if (len) {
+                   while (len--)
+                       *d++ = *s++;
+                   continue;
+               }
            }
        }
 
@@ -1005,6 +1009,7 @@ scan_const(char *start)
            if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
                isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
            {
+               dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_SYNTAX))
                    warner(WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
                *--s = '$';
@@ -1047,8 +1052,12 @@ scan_const(char *start)
 
                    if (!e)
                        yyerror("Missing right brace on \\x{}");
-                   if (ckWARN(WARN_UTF8) && !utf)
-                       warner(WARN_UTF8,"Use of \\x{} without utf8 declaration");
+                   if (!utf) {
+                       dTHR;
+                       if (ckWARN(WARN_UTF8))
+                           warner(WARN_UTF8,
+                                  "Use of \\x{} without utf8 declaration");
+                   }
                    /* note: utf always shorter than hex */
                    d = uv_to_utf8(d, scan_hex(s + 1, e - s - 1, &len));
                    s = e + 1;
@@ -1062,10 +1071,13 @@ scan_const(char *start)
                        d = uv_to_utf8(d, uv);          /* doing a CU or UC */
                    }
                    else {
-                       if (ckWARN(WARN_UTF8) && uv >= 127 && UTF)
-                           warner(WARN_UTF8,
-                               "\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
-                               len,s,len,s);
+                       if (uv >= 127 && UTF) {
+                           dTHR;
+                           if (ckWARN(WARN_UTF8))
+                               warner(WARN_UTF8,
+                                   "\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
+                                   len,s,len,s);
+                       }
                        *d++ = (char)uv;
                    }
                    s += len;
@@ -4823,18 +4835,21 @@ checkcomma(register char *s, char *name, char *what)
 {
     char *w;
 
-    if (ckWARN(WARN_SYNTAX) && *s == ' ' && s[1] == '(') {     /* XXX gotta be a better way */
-       int level = 1;
-       for (w = s+2; *w && level; w++) {
-           if (*w == '(')
-               ++level;
-           else if (*w == ')')
-               --level;
-       }
-       if (*w)
-           for (; *w && isSPACE(*w); w++) ;
-       if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
-           warner(WARN_SYNTAX, "%s (...) interpreted as function",name);
+    if (*s == ' ' && s[1] == '(') {    /* XXX gotta be a better way */
+       dTHR;                           /* only for ckWARN */
+       if (ckWARN(WARN_SYNTAX)) {
+           int level = 1;
+           for (w = s+2; *w && level; w++) {
+               if (*w == '(')
+                   ++level;
+               else if (*w == ')')
+                   --level;
+           }
+           if (*w)
+               for (; *w && isSPACE(*w); w++) ;
+           if (!*w || !strchr(";|})]oaiuw!=", *w))     /* an advisory hack only... */
+               warner(WARN_SYNTAX, "%s (...) interpreted as function",name);
+       }
     }
     while (s < PL_bufend && isSPACE(*s))
        s++;
@@ -5074,6 +5089,7 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
            *d = '\0';
            while (s < send && (*s == ' ' || *s == '\t')) s++;
            if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
+               dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
                    char *brack = *s == '[' ? "[...]" : "{...}";
                    warner(WARN_AMBIGUOUS,
@@ -5092,11 +5108,16 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
                PL_lex_state = LEX_INTERPEND;
            if (funny == '#')
                funny = '@';
-           if (ckWARN(WARN_AMBIGUOUS) && PL_lex_state == LEX_NORMAL &&
-             (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
-               warner(WARN_AMBIGUOUS,
-                   "Ambiguous use of %c{%s} resolved to %c%s",
-                   funny, dest, funny, dest);
+           if (PL_lex_state == LEX_NORMAL) {
+               dTHR;                   /* only for ckWARN */
+               if (ckWARN(WARN_AMBIGUOUS) &&
+                   (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
+               {
+                   warner(WARN_AMBIGUOUS,
+                       "Ambiguous use of %c{%s} resolved to %c%s",
+                       funny, dest, funny, dest);
+               }
+           }
        }
        else {
            s = bracket;                /* let the parser handle it */
@@ -5941,6 +5962,7 @@ scan_num(char *start)
               if -w is on
            */
            if (*s == '_') {
+               dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
                    warner(WARN_SYNTAX, "Misplaced _ in number");
                lastub = ++s;
@@ -5955,8 +5977,11 @@ scan_num(char *start)
        }
 
        /* final misplaced underbar check */
-       if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
-           warner(WARN_SYNTAX, "Misplaced _ in number");
+       if (lastub && s - lastub != 3) {
+           dTHR;
+           if (ckWARN(WARN_SYNTAX))
+               warner(WARN_SYNTAX, "Misplaced _ in number");
+       }
 
        /* read a decimal portion if there is one.  avoid
           3..5 being interpreted as the number 3. followed

diff --git a/universal.c b/universal.c
index 2707e46..9bf3efc 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -53,6 +53,7 @@ isa_lookup(HV *stash, char *name, int len, int level)
                SV* sv = *svp++;
                HV* basestash = gv_stashsv(sv, FALSE);
                if (!basestash) {
+                   dTHR;
                    if (ckWARN(WARN_MISC))
                        warner(WARN_SYNTAX,
                             "Can't locate package %s for @%s::ISA",

diff --git a/util.c b/util.c
index 3788de2..e079d42 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1410,6 +1410,7 @@ warn(const char* pat,...)
 void
 warner(U32  err, const char* pat,...)
 {
+    dTHR;
     va_list args;
     char *message;
     HV *stash;
@@ -1422,7 +1423,7 @@ warner(U32  err, const char* pat,...)
 
     if (ckDEAD(err)) {
 #ifdef USE_THREADS
-        DEBUG_L(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message));
+        DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message));
 #endif /* USE_THREADS */
         if (PL_diehook) {
             /* sv_2cv might call croak() */
@@ -2428,8 +2429,11 @@ scan_oct(char *start, I32 len, I32 *retlen)
        retval = n | (*s++ - '0');
        len--;
     }
-    if (len && (*s == '8' || *s == '9') && ckWARN(WARN_OCTAL))
-       warner(WARN_OCTAL, "Illegal octal digit ignored");
+    if (len && (*s == '8' || *s == '9')) {
+       dTHR;
+       if (ckWARN(WARN_OCTAL))
+           warner(WARN_OCTAL, "Illegal octal digit ignored");
+    }
     *retlen = s - start;
     return retval;
 }
@@ -2449,6 +2453,7 @@ scan_hex(char *start, I32 len, I32 *retlen)
            if (*s == '_')
                continue;
            else {
+               dTHR;
                --s;
                if (ckWARN(WARN_UNSAFE))
                    warner(WARN_UNSAFE,"Illegal hex digit ignored");