From d008e5eb7c415dcc8f8574295483b68ff3443910 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Sun, 9 Aug 1998 14:13:46 +0000 Subject: [PATCH] add missing dTHR; notes for test failures due to small stacksize p4raw-id: //depot/perl@1774 --- doio.c | 40 ++++++++++++++++------- gv.c | 2 ++ op.c | 45 +++++++++++++++----------- sv.c | 58 ++++++++++++++++++++++------------ t/pragma/warn-mg | 1 + t/pragma/warn-regexec | 32 ++++++++++++++++++- toke.c | 87 +++++++++++++++++++++++++++++++++------------------ universal.c | 1 + util.c | 11 +++++-- 9 files changed, 193 insertions(+), 84 deletions(-) diff --git a/doio.c b/doio.c index 87672ed..271218f 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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"); -- 2.7.4