Also the search for cat needs to be _exe-aware.

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index 5224a55..4736f11 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1957,6 +1957,7 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
        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 {
@@ -2057,8 +2058,11 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
        }
 #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;
@@ -2096,6 +2100,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
        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 {
@@ -2250,7 +2255,7 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
     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
@@ -2284,7 +2289,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
     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
@@ -2415,6 +2420,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 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)
@@ -2452,15 +2458,16 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
     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 {
@@ -2469,9 +2476,13 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
            if (result < 0)
                *statusp = -1;
        }
-       return result;
     }
 #endif
+  finish:
+    if (result < 0 && errno == EINTR) {
+       PERL_ASYNC_CHECK();
+    }
+    return result;
 }
 #endif /* !DOSISH || OS2 || WIN32 || NETWARE */
 
@@ -2586,7 +2597,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f
     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
@@ -3884,3 +3895,76 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 #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;
+}
+
+