sv_catpvn(sv, "\n", 1); /* Taken into account in fbm_instr() */
s = (U8*)SvPV_force(sv, len);
(void)SvUPGRADE(sv, SVt_PVBM);
- if (len == 0) /* TAIL might be on on a zero-length string. */
+ if (len == 0) /* TAIL might be on a zero-length string. */
return;
if (len > 2) {
U8 mlen;
PL_restartop = die_where(message, msglen);
JMPENV_JUMP(3);
}
+ else if (!message)
+ message = SvPVx(ERRSV, msglen);
+
{
#ifdef USE_SFIO
/* SFIO can really mess with your errno */
}
}
+/* since we've already done strlen() for both nam and val
+ * we can use that info to make things faster than
+ * sprintf(s, "%s=%s", nam, val)
+ */
+#define my_setenv_format(s, nam, nlen, val, vlen) \
+ Copy(nam, s, nlen, char); \
+ *(s+nlen) = '='; \
+ Copy(val, s+(nlen+1), vlen, char); \
+ *(s+(nlen+1+vlen)) = '\0'
+
#ifdef USE_ENVIRON_ARRAY
/* VMS' and EPOC's my_setenv() is in vms.c and epoc.c */
#if !defined(WIN32) && !defined(NETWARE)
#ifndef PERL_USE_SAFE_PUTENV
/* most putenv()s leak, so we manipulate environ directly */
register I32 i=setenv_getix(nam); /* where does it go? */
+ int nlen, vlen;
if (environ == PL_origenviron) { /* need we copy environment? */
I32 j;
for (max = i; environ[max]; max++) ;
tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
for (j=0; j<max; j++) { /* copy environment */
- tmpenv[j] = (char*)safesysmalloc((strlen(environ[j])+1)*sizeof(char));
- strcpy(tmpenv[j], environ[j]);
+ int len = strlen(environ[j]);
+ tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
+ Copy(environ[j], tmpenv[j], len+1, char);
}
tmpenv[max] = Nullch;
environ = tmpenv; /* tell exec where it is now */
}
else
safesysfree(environ[i]);
- environ[i] = (char*)safesysmalloc((strlen(nam)+strlen(val)+2) * sizeof(char));
+ nlen = strlen(nam);
+ vlen = strlen(val);
- (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
+ environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
+ /* all that work just for this */
+ my_setenv_format(environ[i], nam, nlen, val, vlen);
#else /* PERL_USE_SAFE_PUTENV */
# if defined(__CYGWIN__)
setenv(nam, val, 1);
# else
char *new_env;
-
- new_env = (char*)safesysmalloc((strlen(nam) + strlen(val) + 2) * sizeof(char));
- (void)sprintf(new_env,"%s=%s",nam,val);/* all that work just for this */
+ int nlen = strlen(nam), vlen;
+ if (!val) {
+ val = "";
+ }
+ vlen = strlen(val);
+ new_env = (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
+ /* all that work just for this */
+ my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
# endif /* __CYGWIN__ */
#endif /* PERL_USE_SAFE_PUTENV */
Perl_my_setenv(pTHX_ char *nam,char *val)
{
register char *envstr;
- STRLEN len = strlen(nam) + 3;
+ int nlen = strlen(nam), vlen;
+
if (!val) {
val = "";
}
- len += strlen(val);
- New(904, envstr, len, char);
- (void)sprintf(envstr,"%s=%s",nam,val);
+ vlen = strlen(val);
+ New(904, envstr, nlen+vlen+2, char);
+ my_setenv_format(envstr, nam, nlen, val, vlen);
(void)PerlEnv_putenv(envstr);
Safefree(envstr);
}
did_pipes = 0;
if (n) { /* Error */
int pid2, status;
+ PerlLIO_close(p[This]);
if (n != sizeof(int))
Perl_croak(aTHX_ "panic: kid popen errno read");
do {
}
#endif /* defined OS2 */
/*SUPPRESS 560*/
- if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
+ if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
+ SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), PerlProc_getpid());
+ SvREADONLY_on(GvSV(tmpgv));
+ }
PL_forkprocess = 0;
hv_clear(PL_pidstatus); /* we have no children */
return Nullfp;
did_pipes = 0;
if (n) { /* Error */
int pid2, status;
+ PerlLIO_close(p[This]);
if (n != sizeof(int))
Perl_croak(aTHX_ "panic: kid popen errno read");
do {
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
#ifdef SA_RESTART
-#if !defined(USE_PERLIO) || defined(PERL_OLD_SIGNALS)
+#if defined(PERL_OLD_SIGNALS)
act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
#endif
#endif
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
#ifdef SA_RESTART
-#if !defined(USE_PERLIO) || defined(PERL_OLD_SIGNALS)
+#if defined(PERL_OLD_SIGNALS)
act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
#endif
#endif
return PerlProc_signal(signo, handler);
}
-static int sig_trapped;
+static int sig_trapped; /* XXX signals are process-wide anyway, so we
+ ignore the implications of this for threading */
static
Signal_t
I32
Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
{
+ I32 result;
if (!pid)
return -1;
#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
if (!HAS_WAITPID_RUNTIME)
goto hard_way;
# endif
- return PerlProc_waitpid(pid,statusp,flags);
+ result = PerlProc_waitpid(pid,statusp,flags);
+ goto finish;
#endif
#if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
- return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+ result = wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+ goto finish;
#endif
#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
hard_way:
{
- I32 result;
if (flags)
Perl_croak(aTHX_ "Can't do waitpid with flags");
else {
if (result < 0)
*statusp = -1;
}
- return result;
}
#endif
+ finish:
+ if (result < 0 && errno == EINTR) {
+ PERL_ASYNC_CHECK();
+ }
+ return result;
}
#endif /* !DOSISH || OS2 || WIN32 || NETWARE */
char *xfailed = Nullch;
char tmpbuf[MAXPATHLEN];
register char *s;
- I32 len;
+ I32 len = 0;
int retval;
#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
# define SEARCH_EXTS ".bat", ".cmd", NULL
#endif
}
+/*
+=for apidoc new_vstring
+
+Returns a pointer to the next character after the parsed
+vstring, as well as updating the passed in sv.
+ *
+Function must be called like
+
+ sv = NEWSV(92,5);
+ s = new_vstring(s,sv);
+
+The sv must already be large enough to store the vstring
+passed in.
+
+=cut
+*/
+
+char *
+Perl_new_vstring(pTHX_ char *s, SV *sv)
+{
+ char *pos = s;
+ if (*pos == 'v') pos++; /* get past 'v' */
+ while (isDIGIT(*pos) || *pos == '_')
+ pos++;
+ if (!isALPHA(*pos)) {
+ UV rev;
+ U8 tmpbuf[UTF8_MAXLEN+1];
+ U8 *tmpend;
+
+ if (*s == 'v') s++; /* get past 'v' */
+
+ sv_setpvn(sv, "", 0);
+
+ for (;;) {
+ rev = 0;
+ {
+ /* this is atoi() that tolerates underscores */
+ char *end = pos;
+ UV mult = 1;
+ if ( *(s-1) == '_') {
+ mult = 10;
+ }
+ while (--end >= s) {
+ UV orev;
+ orev = rev;
+ rev += (*end - '0') * mult;
+ mult *= 10;
+ if (orev > rev && ckWARN_d(WARN_OVERFLOW))
+ Perl_warner(aTHX_ WARN_OVERFLOW,
+ "Integer overflow in decimal number");
+ }
+ }
+ /* Append native character for the rev point */
+ tmpend = uvchr_to_utf8(tmpbuf, rev);
+ sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
+ if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
+ SvUTF8_on(sv);
+ if ( (*pos == '.' || *pos == '_') && isDIGIT(pos[1]))
+ s = ++pos;
+ else {
+ s = pos;
+ break;
+ }
+ while (isDIGIT(*pos) )
+ pos++;
+ }
+ SvPOK_on(sv);
+ SvREADONLY_on(sv);
+ }
+ return s;
+}
+
+
projects / p5sagit/p5-mst-13.2.git / blobdiff