rewrote deprecate test using File::Spec

[perl5.git] / util.c

diff --git a/util.c b/util.c
index 67d0a13..ea84cda 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1271,14 +1271,14 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
     else {
 #ifdef USE_SFIO
        /* SFIO can really mess with your errno */
-       const int e = errno;
+       dSAVED_ERRNO;
 #endif
        PerlIO * const serr = Perl_error_log;
 
        PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
        (void)PerlIO_flush(serr);
 #ifdef USE_SFIO
-       errno = e;
+       RESTORE_ERRNO;
 #endif
     }
 }
@@ -1454,7 +1454,7 @@ sidestepping the normal C order of execution. See C<warn>.
 If you want to throw an exception object, assign the object to
 C<$@> and then pass C<NULL> to croak():
 
-   errsv = get_sv("@", TRUE);
+   errsv = get_sv("@", GV_ADD);
    sv_setsv(errsv, exception_object);
    croak(NULL);
 
@@ -1667,9 +1667,16 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
 #ifndef PERL_USE_SAFE_PUTENV
     if (!PL_use_safe_putenv) {
     /* most putenv()s leak, so we manipulate environ directly */
-    register I32 i=setenv_getix(nam);          /* where does it go? */
+    register I32 i;
+    register const I32 len = strlen(nam);
     int nlen, vlen;
 
+    /* where does it go? */
+    for (i = 0; environ[i]; i++) {
+        if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
+            break;
+    }
+
     if (environ == PL_origenviron) {   /* need we copy environment? */
        I32 j;
        I32 max;
@@ -1773,30 +1780,6 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
 
 #endif /* WIN32 || NETWARE */
 
-#ifndef PERL_MICRO
-static I32
-S_setenv_getix(pTHX_ const char *nam)
-{
-    register I32 i;
-    register const I32 len = strlen(nam);
-
-    PERL_ARGS_ASSERT_SETENV_GETIX;
-    PERL_UNUSED_CONTEXT;
-
-    for (i = 0; environ[i]; i++) {
-       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;
-}
-#endif /* !PERL_MICRO */
-
 #endif /* !VMS && !EPOC*/
 
 #ifdef UNLINK_ALL_VERSIONS
@@ -2305,6 +2288,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
            }
            return NULL;
        }
+       if (ckWARN(WARN_PIPE))
+           Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
        sleep(5);
     }
     if (pid == 0) {
@@ -2450,9 +2435,11 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
                PerlLIO_close(pp[1]);
            }
            if (!doexec)
-               Perl_croak(aTHX_ "Can't fork");
+               Perl_croak(aTHX_ "Can't fork: %s", Strerror(errno));
            return NULL;
        }
+       if (ckWARN(WARN_PIPE))
+           Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
        sleep(5);
     }
     if (pid == 0) {
@@ -2879,10 +2866,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     Pid_t pid;
     Pid_t pid2;
     bool close_failed;
-    int saved_errno = 0;
-#ifdef WIN32
-    int saved_win32_errno;
-#endif
+    dSAVEDERRNO;
 
     LOCK_FDPID_MUTEX;
     svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
@@ -2895,12 +2879,8 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
        return my_syspclose(ptr);
     }
 #endif
-    if ((close_failed = (PerlIO_close(ptr) == EOF))) {
-       saved_errno = errno;
-#ifdef WIN32
-       saved_win32_errno = GetLastError();
-#endif
-    }
+    close_failed = (PerlIO_close(ptr) == EOF);
+    SAVE_ERRNO;
 #ifdef UTS
     if(PerlProc_kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
 #endif
@@ -2918,7 +2898,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     rsignal_restore(SIGQUIT, &qstat);
 #endif
     if (close_failed) {
-       SETERRNO(saved_errno, 0);
+       RESTORE_ERRNO;
        return -1;
     }
     return(pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status));
@@ -5069,12 +5049,12 @@ S_socketpair_udp (int fd[2]) {
     errno = ECONNABORTED;
   tidy_up_and_fail:
     {
-       const int save_errno = errno;
+       dSAVE_ERRNO;
        if (sockets[0] != -1)
            PerlLIO_close(sockets[0]);
        if (sockets[1] != -1)
            PerlLIO_close(sockets[1]);
-       errno = save_errno;
+       RESTORE_ERRNO;
        return -1;
     }
 }
@@ -5173,14 +5153,14 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
 #endif
   tidy_up_and_fail:
     {
-       const int save_errno = errno;
+       dSAVE_ERRNO;
        if (listener != -1)
            PerlLIO_close(listener);
        if (connector != -1)
            PerlLIO_close(connector);
        if (acceptor != -1)
            PerlLIO_close(acceptor);
-       errno = save_errno;
+       RESTORE_ERRNO;
        return -1;
     }
 }
@@ -5588,7 +5568,7 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const cha
         (void)time(&when);
 #   endif
        /* If there are other OS specific ways of hires time than
-        * gettimeofday() (see ext/Time/HiRes), the easiest way is
+        * gettimeofday() (see ext/Time-HiRes), the easiest way is
         * probably that they would be used to fill in the struct
         * timeval. */
 # endif