#endif /* LEAKTEST */
-/* copy a string up to some (non-backslashed) delimiter, if any */
+/* copy a string up to some (non-backslashed) delimiter, if any;
+ If the delimiter is ';', then do not consider backslashes -
+ used only for PATH on DOSISH systems. */
char *
-cpytill(to,from,fromend,delim,retlen)
+delimcpy(to, toend, from, fromend, delim, retlen)
register char *to;
+register char *toend;
register char *from;
register char *fromend;
register int delim;
I32 *retlen;
{
- char *origto = to;
-
- for (; from < fromend; from++,to++) {
- if (*from == '\\') {
+ register I32 tolen;
+ for (tolen = 0; from < fromend; from++, tolen++) {
+ if (*from == '\\' && delim != ';') {
if (from[1] == delim)
from++;
- else if (from[1] == '\\')
- *to++ = *from++;
+ else {
+ if (to < toend)
+ *to++ = *from;
+ tolen++;
+ from++;
+ }
}
else if (*from == delim)
break;
- *to = *from;
+ if (to < toend)
+ *to++ = *from;
}
- *to = '\0';
- *retlen = to - origto;
+ if (to < toend)
+ *to = '\0';
+ *retlen = tolen;
return from;
}
return newaddr;
}
+/* the SV for form() and mess() is not kept in an arena */
+
+static SV *
+mess_alloc()
+{
+ SV *sv;
+ XPVMG *any;
+
+ /* Create as PVMG now, to avoid any upgrading later */
+ New(905, sv, 1, SV);
+ Newz(905, any, 1, XPVMG);
+ SvFLAGS(sv) = SVt_PVMG;
+ SvANY(sv) = (void*)any;
+ SvREFCNT(sv) = 1 << 30; /* practically infinite */
+ return sv;
+}
+
#ifdef I_STDARG
char *
form(const char* pat, ...)
#else
va_start(args);
#endif
- if (mess_sv == &sv_undef) {
- /* All late-destruction message must be short */
- vsprintf(tokenbuf, pat, args);
- }
- else {
- if (!mess_sv)
- mess_sv = NEWSV(905, 0);
- sv_vsetpvfn(mess_sv, pat, strlen(pat), &args,
- Null(SV**), 0, Null(bool));
- }
+ if (!mess_sv)
+ mess_sv = mess_alloc();
+ sv_vsetpvfn(mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
- return (mess_sv == &sv_undef) ? tokenbuf : SvPVX(mess_sv);
+ return SvPVX(mess_sv);
}
char *
SV *sv;
static char dgd[] = " during global destruction.\n";
- if (mess_sv == &sv_undef) {
- /* All late-destruction message must be short */
- vsprintf(tokenbuf, pat, *args);
- if (!tokenbuf[0] && tokenbuf[strlen(tokenbuf) - 1] != '\n')
- strcat(tokenbuf, dgd);
- return tokenbuf;
- }
if (!mess_sv)
- mess_sv = NEWSV(905, 0);
+ mess_sv = mess_alloc();
sv = mess_sv;
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool));
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
if (dirty)
sv_catpv(sv, dgd);
else {
if (curcop->cop_line)
- sv_catpvf(sv, " at %S line %ld",
+ sv_catpvf(sv, " at %_ line %ld",
GvSV(curcop->cop_filegv), (long)curcop->cop_line);
if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
bool line_mode = (RsSIMPLE(rs) &&
}
#ifndef VMS /* VMS' my_setenv() is in VMS.c */
-#ifndef _WIN32
+#ifndef WIN32
void
my_setenv(nam,val)
char *nam, *val;
#endif /* MSDOS */
}
+#else /* if WIN32 */
+
+void
+my_setenv(nam,val)
+char *nam, *val;
+{
+
+#ifdef USE_WIN32_RTL_ENV
+
+ register char *envstr;
+ STRLEN namlen = strlen(nam);
+ STRLEN vallen;
+ char *oldstr = environ[setenv_getix(nam)];
+
+ /* putenv() has totally broken semantics in both the Borland
+ * and Microsoft CRTLs. They either store the passed pointer in
+ * the environment without making a copy, or make a copy and don't
+ * free it. And on top of that, they dont free() old entries that
+ * are being replaced/deleted. This means the caller must
+ * free any old entries somehow, or we end up with a memory
+ * leak every time my_setenv() is called. One might think
+ * one could directly manipulate environ[], like the UNIX code
+ * above, but direct changes to environ are not allowed when
+ * calling putenv(), since the RTLs maintain an internal
+ * *copy* of environ[]. Bad, bad, *bad* stink.
+ * GSAR 97-06-07
+ */
+
+ if (!val) {
+ if (!oldstr)
+ return;
+ val = "";
+ vallen = 0;
+ }
+ else
+ vallen = strlen(val);
+ New(904, envstr, namlen + vallen + 3, char);
+ (void)sprintf(envstr,"%s=%s",nam,val);
+ (void)putenv(envstr);
+ if (oldstr)
+ Safefree(oldstr);
+#ifdef _MSC_VER
+ Safefree(envstr); /* MSVCRT leaks without this */
+#endif
+
+#else /* !USE_WIN32_RTL_ENV */
+
+ /* The sane way to deal with the environment.
+ * Has these advantages over putenv() & co.:
+ * * enables us to store a truly empty value in the
+ * environment (like in UNIX).
+ * * we don't have to deal with RTL globals, bugs and leaks.
+ * * Much faster.
+ * Why you may want to enable USE_WIN32_RTL_ENV:
+ * * environ[] and RTL functions will not reflect changes,
+ * which might be an issue if extensions want to access
+ * the env. via RTL. This cuts both ways, since RTL will
+ * not see changes made by extensions that call the Win32
+ * functions directly, either.
+ * GSAR 97-06-07
+ */
+ SetEnvironmentVariable(nam,val);
+
+#endif
+}
+
+#endif /* WIN32 */
+
I32
setenv_getix(nam)
char *nam;
register I32 i, len = strlen(nam);
for (i = 0; environ[i]; i++) {
- if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
+ if (
+#ifdef WIN32
+ strnicmp(environ[i],nam,len) == 0
+#else
+ strnEQ(environ[i],nam,len)
+#endif
+ && environ[i][len] == '=')
break; /* strnEQ must come first to avoid */
} /* potential SEGV's */
return i;
}
-#else /* if _WIN32 */
-
-void
-my_setenv(nam,val)
-char *nam, *val;
-{
- register char *envstr;
- STRLEN namlen = strlen(nam);
- STRLEN vallen = strlen(val ? val : "");
-
- New(9040, envstr, namlen + vallen + 3, char);
- (void)sprintf(envstr,"%s=%s",nam,val);
- if (!vallen) {
- /* An attempt to delete the entry.
- * We try to fix a Win32 process handling goof: Children
- * of the current process will end up seeing the
- * grandparent's entry if the current process has never
- * modified the entry being deleted. So we call _putenv()
- * twice: once to pretend to modify the entry, and the
- * second time to actually delete it. GSAR 97-03-19
- */
- envstr[namlen+1] = 'X'; envstr[namlen+2] = '\0';
- (void)_putenv(envstr);
- envstr[namlen+1] = '\0';
- }
- (void)_putenv(envstr);
-}
-
-#endif /* _WIN32 */
#endif /* !VMS */
#ifdef UNLINK_ALL_VERSIONS
}
#endif
+#ifndef HAS_MEMSET
+void *
+my_memset(loc,ch,len)
+register char *loc;
+register I32 ch;
+register I32 len;
+{
+ char *retval = loc;
+
+ while (len--)
+ *loc++ = ch;
+ return retval;
+}
+#endif
+
#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
char *
my_bzero(loc,len)
close(newfd);
return fcntl(oldfd, F_DUPFD, newfd);
#else
- int fdtmp[256];
+#define DUP2_MAX_FDS 256
+ int fdtmp[DUP2_MAX_FDS];
I32 fdx = 0;
int fd;
if (oldfd == newfd)
return oldfd;
close(newfd);
- while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
+ /* good enough for low fd's... */
+ while ((fd = dup(oldfd)) != newfd && fd >= 0) {
+ if (fdx >= DUP2_MAX_FDS) {
+ close(fd);
+ fd = -1;
+ break;
+ }
fdtmp[fdx++] = fd;
+ }
while (fdx > 0)
close(fdtmp[--fdx]);
return fd;
int status;
SV **svp;
int pid;
+ bool close_failed;
+ int saved_errno;
+#ifdef VMS
+ int saved_vaxc_errno;
+#endif
svp = av_fetch(fdpid,PerlIO_fileno(ptr),TRUE);
pid = (int)SvIVX(*svp);
return my_syspclose(ptr);
}
#endif
- PerlIO_close(ptr);
+ if ((close_failed = (PerlIO_close(ptr) == EOF))) {
+ saved_errno = errno;
+#ifdef VMS
+ saved_vaxc_errno = vaxc$errno;
+#endif
+ }
#ifdef UTS
if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
#endif
rsignal_restore(SIGHUP, &hstat);
rsignal_restore(SIGINT, &istat);
rsignal_restore(SIGQUIT, &qstat);
- return(pid < 0 ? pid : status);
+ if (close_failed) {
+ SETERRNO(saved_errno, saved_vaxc_errno);
+ return -1;
+ }
+ return(pid < 0 ? pid : status == 0 ? 0 : (errno = 0, status));
}
#endif /* !DOSISH */
{
SV *sv;
SV** svp;
- char spid[sizeof(int) * 3 + 1];
+ char spid[TYPE_CHARS(int)];
if (!pid)
return -1;
int status;
{
register SV *sv;
- char spid[sizeof(int) * 3 + 1];
+ char spid[TYPE_CHARS(int)];
sprintf(spid, "%d", pid);
sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);