Skip to content

Commit

Permalink
Patch for LONG_MAX & co.
Browse files Browse the repository at this point in the history 
    __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.
  • Loading branch information
Perl 5 Porters authored and Andy Dougherty committed Aug 30, 1996
1 parent 08cb0b0 commit 20cec16
Showing 1 changed file with 81 additions and 55 deletions.
136 changes: 81 additions & 55 deletions util.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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) */
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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) */

Expand Down Expand Up @@ -1717,38 +1743,38 @@ double f;
ccflags.
--Andy Dougherty <doughera@lafcol.lafayette.edu>
*/
#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;
}

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;
}

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;
}

Expand Down

0 comments on commit 20cec16

Please sign in to comment.