From: Tim Bunce Date: Sat, 3 Feb 1996 08:50:59 +0000 (+0000) Subject: Re: Strange coredump in Tk X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f0c5b2233f4e183c2c3a5c4854bb979b857edc3b;p=p5sagit%2Fp5-mst-13.2.git Re: Strange coredump in Tk Move perl_init_i18nl14n here from miniperlmain.c. --- diff --git a/util.c b/util.c index 71ef5c9..8ce3d32 100644 --- a/util.c +++ b/util.c @@ -353,6 +353,48 @@ char *lend; return Nullch; } +/* Initialize locale (and the fold[] array).*/ +int +perl_init_i18nl14n(printwarn) + int printwarn; +{ + int ok = 1; + /* returns + * 1 = set ok or not applicable, + * 0 = fallback to C locale, + * -1 = fallback to C locale failed + */ +#if defined(HAS_SETLOCALE) && defined(LC_CTYPE) + char * lang = getenv("LANG"); + char * lc_all = getenv("LC_ALL"); + char * lc_ctype = getenv("LC_CTYPE"); + int i; + + if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) { + if (printwarn) { + fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n"); + fprintf(stderr, + "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n", + lc_all ? lc_all : "(null)", + lc_ctype ? lc_ctype : "(null)", + lang ? lang : "(null)" + ); + fprintf(stderr, "warning: falling back to the \"C\" locale.\n"); + } + ok = 0; + if (setlocale(LC_CTYPE, "C") == NULL) + ok = -1; + } + + for (i = 0; i < 256; i++) { + if (isUPPER(i)) fold[i] = toLOWER(i); + else if (isLOWER(i)) fold[i] = toUPPER(i); + else fold[i] = i; + } +#endif + return ok; +} + void fbm_compile(sv, iflag) SV *sv; @@ -703,10 +745,11 @@ char *pat; long a1, a2, a3, a4; { char *s; + char *s_start; I32 usermess = strEQ(pat,"%s"); SV *tmpstr; - s = buf; + s = s_start = buf; if (usermess) { tmpstr = sv_newmortal(); sv_setpv(tmpstr, (char*)a1); @@ -735,10 +778,20 @@ long a1, a2, a3, a4; s += strlen(s); } (void)strcpy(s,".\n"); + s += 2; } if (usermess) sv_catpv(tmpstr,buf+1); } + + if (s - s_start >= sizeof(buf)) { /* Ooops! */ + if (usermess) + fputs(SvPVX(tmpstr), stderr); + else + fputs(buf, stderr); + fputs("panic: message overflow - memory corrupted!\n",stderr); + my_exit(1); + } if (usermess) return SvPVX(tmpstr); else @@ -772,8 +825,12 @@ long a1, a2, a3, a4; } fputs(message,stderr); (void)fflush(stderr); - if (e_fp) + if (e_fp) { +#ifdef DOSISH + fclose(e_fp); +#endif (void)UNLINK(e_tmpname); + } statusvalue = SHIFTSTATUS(statusvalue); #ifdef VMS my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT); @@ -826,6 +883,7 @@ mess(pat, args) #endif { char *s; + char *s_start; SV *tmpstr; I32 usermess; #ifndef HAS_VPRINTF @@ -836,7 +894,7 @@ mess(pat, args) #endif #endif - s = buf; + s = s_start = buf; usermess = strEQ(pat, "%s"); if (usermess) { tmpstr = sv_newmortal(); @@ -868,11 +926,20 @@ mess(pat, args) s += strlen(s); } (void)strcpy(s,".\n"); + s += 2; } if (usermess) sv_catpv(tmpstr,buf+1); } + if (s - s_start >= sizeof(buf)) { /* Ooops! */ + if (usermess) + fputs(SvPVX(tmpstr), stderr); + else + fputs(buf, stderr); + fputs("panic: message overflow - memory corrupted!\n",stderr); + my_exit(1); + } if (usermess) return SvPVX(tmpstr); else @@ -918,8 +985,12 @@ croak(pat, va_alist) } fputs(message,stderr); (void)fflush(stderr); - if (e_fp) + if (e_fp) { +#ifdef DOSISH + fclose(e_fp); +#endif (void)UNLINK(e_tmpname); + } statusvalue = SHIFTSTATUS(statusvalue); #ifdef VMS my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44))); @@ -1287,7 +1358,8 @@ VTOH(vtohs,short) VTOH(vtohl,long) #endif -#if !defined(DOSISH) && !defined(VMS) /* VMS' my_popen() is in VMS.c */ +#if !defined(DOSISH) && !defined(VMS) /* VMS' my_popen() is in + VMS.c, same with OS/2. */ FILE * my_popen(cmd,mode) char *cmd; @@ -1364,7 +1436,7 @@ char *mode; return fdopen(p[this], mode); } #else -#if defined(atarist) || defined(OS2) +#if defined(atarist) FILE *popen(); FILE * my_popen(cmd,mode)