From: Perl 5 Porters Date: Fri, 30 Aug 1996 01:52:45 +0000 (+0000) Subject: Patch for LONG_MAX & co. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=20cec16afc5978d179efa41282d3f0a2034f1b78;p=p5sagit%2Fp5-mst-13.2.git Patch for LONG_MAX & co. __DIE__ (with patch) sv_2pv() might call croak() (which is not prepared to handle that when it calls sv_2pv(), itself). Likewise for warn() (but under slightly more esoteric circumstances--mg_get() in sv_2pv() might trigger a call to warn()). PERL_BADLANG is examined by default before issuing a warning during internationalization. --- diff --git a/util.c b/util.c index fa34ace..810cda7 100644 --- a/util.c +++ b/util.c @@ -55,6 +55,7 @@ static void xstat _((void)); /* NOTE: Do not call the next three routines directly. Use the macros * in handy.h, so that we can easily redefine everything to do tracking of * allocated hunks back to the original New to track down any memory leaks. + * XXX This advice seems to be widely ignored :-( --AD August 1996. */ Malloc_t @@ -421,7 +422,10 @@ perl_init_i18nl10n(printwarn) int i; if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) { - if (printwarn) { + char *doit; + + if (printwarn > 1 || + printwarn && (!(doit = getenv("PERL_BADLANG")) || atoi(doit))) { PerlIO_printf(PerlIO_stderr(), "warning: setlocale(LC_CTYPE, \"\") failed.\n"); PerlIO_printf(PerlIO_stderr(), "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n", @@ -860,14 +864,20 @@ long a1, a2, a3, a4; CV *cv; message = mess(pat,a1,a2,a3,a4); - if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) { - dSP; - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); + if (diehook) { + SV *olddiehook = diehook; + diehook = Nullsv; /* sv_2cv might call croak() */ + cv = sv_2cv(olddiehook, &stash, &gv, 0); + diehook = olddiehook; + if (cv && !CvDEPTH(cv)) { + dSP; + + PUSHMARK(sp); + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVpv(message,0))); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + } } if (in_eval) { restartop = die_where(message); @@ -904,22 +914,27 @@ long a1, a2, a3, a4; CV *cv; message = mess(pat,a1,a2,a3,a4); - if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) { - dSP; - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); + if (warnhook) { + SV *oldwarnhook = warnhook; + warnhook = Nullsv; /* sv_2cv might end up calling warn() */ + cv = sv_2cv(oldwarnhook, &stash, &gv, 0); + warnhook = oldwarnhook; + if (cv && !CvDEPTH(cv)) { + dSP; + + PUSHMARK(sp); + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVpv(message,0))); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + return; + } } - else { - PerlIO_puts(PerlIO_stderr(),message); + PerlIO_puts(PerlIO_stderr(),message); #ifdef LEAKTEST - DEBUG_L(xstat()); + DEBUG_L(xstat()); #endif - (void)Fflush(PerlIO_stderr()); - } + (void)PerlIO_flush(PerlIO_stderr()); } #else /* !defined(I_STDARG) && !defined(I_VARARGS) */ @@ -1023,14 +1038,20 @@ croak(pat, va_alist) #endif message = mess(pat, &args); va_end(args); - if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) { - dSP; - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); + if (diehook) { + SV *olddiehook = diehook; + diehook = Nullsv; /* sv_2cv might call croak() */ + cv = sv_2cv(olddiehook, &stash, &gv, 0); + diehook = olddiehook; + if (cv && !CvDEPTH(cv)) { + dSP; + + PUSHMARK(sp); + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVpv(message,0))); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + } } if (in_eval) { restartop = die_where(message); @@ -1079,22 +1100,27 @@ warn(pat,va_alist) message = mess(pat, &args); va_end(args); - if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) { - dSP; - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); + if (warnhook) { + SV *oldwarnhook = warnhook; + warnhook = Nullsv; /* sv_2cv might end up calling warn() */ + cv = sv_2cv(oldwarnhook, &stash, &gv, 0); + warnhook = oldwarnhook; + if (cv && !CvDEPTH(cv)) { + dSP; + + PUSHMARK(sp); + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVpv(message,0))); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + return; + } } - else { - PerlIO_puts(PerlIO_stderr(),message); + PerlIO_puts(PerlIO_stderr(),message); #ifdef LEAKTEST - DEBUG_L(xstat()); + DEBUG_L(xstat()); #endif - (void)PerlIO_flush(PerlIO_stderr()); - } + (void)PerlIO_flush(PerlIO_stderr()); } #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */ @@ -1717,18 +1743,18 @@ double f; ccflags. --Andy Dougherty */ -#ifndef MY_ULONG_MAX -# define MY_ULONG_MAX ((UV)PERL_LONG_MAX * (UV)2 + (UV)1) +#ifndef MY_UV_MAX +# define MY_UV_MAX ((UV)IV_MAX * (UV)2 + (UV)1) #endif I32 cast_i32(f) double f; { - if (f >= PERL_LONG_MAX) - return (I32) PERL_LONG_MAX; - if (f <= PERL_LONG_MIN) - return (I32) PERL_LONG_MIN; + if (f >= I32_MAX) + return (I32) I32_MAX; + if (f <= I32_MIN) + return (I32) I32_MIN; return (I32) f; } @@ -1736,10 +1762,10 @@ IV cast_iv(f) double f; { - if (f >= PERL_LONG_MAX) - return (IV) PERL_LONG_MAX; - if (f <= PERL_LONG_MIN) - return (IV) PERL_LONG_MIN; + if (f >= IV_MAX) + return (IV) IV_MAX; + if (f <= IV_MIN) + return (IV) IV_MIN; return (IV) f; } @@ -1747,8 +1773,8 @@ UV cast_uv(f) double f; { - if (f >= MY_ULONG_MAX) - return (UV) MY_ULONG_MAX; + if (f >= MY_UV_MAX) + return (UV) MY_UV_MAX; return (UV) f; }