#ifdef USE_LOCALE
-#ifdef LC_ALL
- char *lc_all = getenv("LC_ALL");
-#endif /* LC_ALL */
#ifdef USE_LOCALE_CTYPE
- char *lc_ctype = getenv("LC_CTYPE");
char *curctype = NULL;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- char *lc_collate = getenv("LC_COLLATE");
char *curcoll = NULL;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- char *lc_numeric = getenv("LC_NUMERIC");
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
+ char *lc_all = getenv("LC_ALL");
char *lang = getenv("LANG");
bool setlocale_failure = FALSE;
+#ifdef LOCALE_ENVIRON_REQUIRED
+
+ /*
+ * Ultrix setlocale(..., "") fails if there are no environment
+ * variables from which to get a locale name.
+ */
+
+ bool done = FALSE;
+
+#ifdef LC_ALL
+ if (lang) {
+ if (setlocale(LC_ALL, ""))
+ done = TRUE;
+ else
+ setlocale_failure = TRUE;
+ }
+ if (!setlocale_failure)
+#endif /* LC_ALL */
+ {
+#ifdef USE_LOCALE_CTYPE
+ if (! (curctype = setlocale(LC_CTYPE,
+ (!done && (lang || getenv("LC_CTYPE")))
+ ? "" : Nullch)))
+ setlocale_failure = TRUE;
+#endif /* USE_LOCALE_CTYPE */
+#ifdef USE_LOCALE_COLLATE
+ if (! (curcoll = setlocale(LC_COLLATE,
+ (!done && (lang || getenv("LC_COLLATE")))
+ ? "" : Nullch)))
+ setlocale_failure = TRUE;
+#endif /* USE_LOCALE_COLLATE */
+#ifdef USE_LOCALE_NUMERIC
+ if (! (curnum = setlocale(LC_NUMERIC,
+ (!done && (lang || getenv("LC_NUMERIC")))
+ ? "" : Nullch)))
+ setlocale_failure = TRUE;
+#endif /* USE_LOCALE_NUMERIC */
+ }
+
+#else /* !LOCALE_ENVIRON_REQUIRED */
+
#ifdef LC_ALL
if (! setlocale(LC_ALL, ""))
#endif /* LC_ALL */
+#endif /* !LOCALE_ENVIRON_REQUIRED */
+
if (setlocale_failure) {
char *p;
bool locwarn = (printwarn > 1 ||
PerlIO_printf(PerlIO_stderr(),
"perl: warning: Please check that your locale settings:\n");
-#ifdef LC_ALL
PerlIO_printf(PerlIO_stderr(),
"\tLC_ALL = %c%s%c,\n",
lc_all ? '"' : '(',
lc_all ? lc_all : "unset",
lc_all ? '"' : ')');
-#endif /* LC_ALL */
{
char **e;
if (usermess) {
tmpstr = sv_newmortal();
sv_setpv(tmpstr, va_arg(*args, char *));
- *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
+ *s++ = SvCUR(tmpstr) ? SvPVX(tmpstr)[SvCUR(tmpstr)-1] : ' ';
}
else {
(void) vsprintf(s,pat,*args);
message = mess(pat, &args);
va_end(args);
- if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
- dSP;
- SV *msg = sv_2mortal(newSVpv(message, 0));
+ if (diehook) {
+ /* sv_2cv might call croak() */
+ SV *olddiehook = diehook;
+ ENTER;
+ SAVESPTR(diehook);
+ diehook = Nullsv;
+ cv = sv_2cv(olddiehook, &stash, &gv, 0);
+ LEAVE;
+ if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
+ dSP;
+ SV *msg = sv_2mortal(newSVpv(message, 0));
- PUSHMARK(sp);
- EXTEND(sp, 1);
- PUSHs(msg);
- PUTBACK;
- perl_call_sv((SV*)cv, G_DISCARD);
+ PUSHMARK(sp);
+ XPUSHs(msg);
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
- /* It's okay for the __DIE__ hook to modify the message. */
- message = SvPV(msg, na);
+ /* It's okay for the __DIE__ hook to modify the message. */
+ message = SvPV(msg, na);
+ }
}
restartop = die_where(message);
message = mess(pat, &args);
va_end(args);
if (diehook) {
+ /* sv_2cv might call croak() */
SV *olddiehook = diehook;
- diehook = Nullsv; /* sv_2cv might call croak() */
+ ENTER;
+ SAVESPTR(diehook);
+ diehook = Nullsv;
cv = sv_2cv(olddiehook, &stash, &gv, 0);
- diehook = olddiehook;
- if (cv && !CvDEPTH(cv)) {
+ LEAVE;
+ if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
SV *msg = sv_2mortal(newSVpv(message, 0));
PUSHMARK(sp);
- EXTEND(sp, 1);
- PUSHs(msg);
+ XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
va_end(args);
if (warnhook) {
+ /* sv_2cv might call warn() */
SV *oldwarnhook = warnhook;
- warnhook = Nullsv; /* sv_2cv might end up calling warn() */
+ ENTER;
+ SAVESPTR(warnhook);
+ warnhook = Nullsv;
cv = sv_2cv(oldwarnhook, &stash, &gv, 0);
- warnhook = oldwarnhook;
- if (cv && !CvDEPTH(cv)) {
+ LEAVE;
+ if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
-
PUSHMARK(sp);
- EXTEND(sp, 1);
- PUSHs(sv_2mortal(newSVpv(message,0)));
+ XPUSHs(sv_2mortal(newSVpv(message,0)));
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
return;
register I32 this, that;
register I32 pid;
SV *sv;
- I32 doexec =
-#ifdef AMIGAOS
- 1;
-#else
- strNE(cmd,"-");
-#endif
+ I32 doexec = strNE(cmd,"-");
#ifdef OS2
if (doexec) {