This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
added patch, with tweaks
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 7479e47..f61b66d 100644 (file)
--- a/util.c
+++ b/util.c
@@ -14,7 +14,6 @@
 
 #include "EXTERN.h"
 #include "perl.h"
-#include "perlmem.h"
 
 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
@@ -122,13 +121,18 @@ saferealloc(Malloc_t where,MEM_SIZE size)
        my_exit(1);
     }
 #endif /* HAS_64K_LIMIT */
+    if (!size) {
+       safefree(where);
+       return NULL;
+    }
+
     if (!where)
-       croak("Null realloc");
+       return safemalloc(size);
 #ifdef DEBUGGING
     if ((long)size < 0)
        croak("panic: realloc");
 #endif
-    ptr = PerlMem_realloc(where,size?size:1);  /* realloc(0) is NASTY on our system */
+    ptr = PerlMem_realloc(where,size);
 
 #if !(defined(I286) || defined(atarist))
     DEBUG_m( {
@@ -1285,12 +1289,12 @@ die(const char* pat, ...)
                msg = ERRSV;
            }
 
-           PUSHSTACK(SI_DIEHOOK);
+           PUSHSTACKi(SI_DIEHOOK);
            PUSHMARK(SP);
            XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
-           POPSTACK();
+           POPSTACK;
            LEAVE;
        }
     }
@@ -1339,12 +1343,12 @@ croak(const char* pat, ...)
            SvREADONLY_on(msg);
            SAVEFREESV(msg);
 
-           PUSHSTACK(SI_DIEHOOK);
+           PUSHSTACKi(SI_DIEHOOK);
            PUSHMARK(SP);
            XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
-           POPSTACK();
+           POPSTACK;
            LEAVE;
        }
     }
@@ -1388,12 +1392,12 @@ warn(const char* pat,...)
            SvREADONLY_on(msg);
            SAVEFREESV(msg);
 
-           PUSHSTACK(SI_WARNHOOK);
+           PUSHSTACKi(SI_WARNHOOK);
            PUSHMARK(SP);
            XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
-           POPSTACK();
+           POPSTACK;
            LEAVE;
            return;
        }
@@ -2129,7 +2133,7 @@ wait4pid(int pid, int *statusp, int flags)
     if (!HAS_WAITPID_RUNTIME)
        goto hard_way;
 #  endif
-    return waitpid(pid,statusp,flags);
+    return PerlProc_waitpid(pid,statusp,flags);
 #endif
 #if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
@@ -2372,6 +2376,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
     dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
+    char tmpbuf[512];
     register char *s;
     I32 len;
     int retval;
@@ -2415,6 +2420,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
      *     + look *only* in the PATH for scriptname{,.foo,.bar} (note
      *       this will not look in '.' if it's not in the PATH)
      */
+    tmpbuf[0] = '\0';
 
 #ifdef VMS
 #  ifdef ALWAYS_DEFTYPES
@@ -2434,16 +2440,16 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
        /* The first time through, just add SEARCH_EXTS to whatever we
         * already have, so we can check for default file types. */
        while (deftypes ||
-              (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) )
+              (!hasdir && my_trnlnm("DCL$PATH",tmpbuf,idx++)) )
        {
            if (deftypes) {
                deftypes = 0;
-               *tokenbuf = '\0';
+               *tmpbuf = '\0';
            }
-           if ((strlen(tokenbuf) + strlen(scriptname)
-                + MAX_EXT_LEN) >= sizeof tokenbuf)
+           if ((strlen(tmpbuf) + strlen(scriptname)
+                + MAX_EXT_LEN) >= sizeof tmpbuf)
                continue;       /* don't search dir with too-long name */
-           strcat(tokenbuf, scriptname);
+           strcat(tmpbuf, scriptname);
 #else  /* !VMS */
 
 #ifdef DOSISH
@@ -2472,12 +2478,12 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 #ifdef SEARCH_EXTS
            if (cur == scriptname) {
                len = strlen(scriptname);
-               if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf))
+               if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf))
                    break;
-               cur = strcpy(tokenbuf, scriptname);
+               cur = strcpy(tmpbuf, scriptname);
            }
        } while (extidx >= 0 && ext[extidx]     /* try an extension? */
-                && strcpy(tokenbuf+len, ext[extidx++]));
+                && strcpy(tmpbuf+len, ext[extidx++]));
 #endif
     }
 #endif
@@ -2497,44 +2503,44 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
                    && *s != ','
 #  endif
                    && *s != ';'; len++, s++) {
-               if (len < sizeof tokenbuf)
-                   tokenbuf[len] = *s;
+               if (len < sizeof tmpbuf)
+                   tmpbuf[len] = *s;
            }
-           if (len < sizeof tokenbuf)
-               tokenbuf[len] = '\0';
+           if (len < sizeof tmpbuf)
+               tmpbuf[len] = '\0';
 #else  /* ! (atarist || DOSISH) */
-           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
+           s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend,
                        ':',
                        &len);
 #endif /* ! (atarist || DOSISH) */
            if (s < bufend)
                s++;
-           if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
+           if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf)
                continue;       /* don't search dir with too-long name */
            if (len
 #if defined(atarist) || defined(DOSISH)
-               && tokenbuf[len - 1] != '/'
-               && tokenbuf[len - 1] != '\\'
+               && tmpbuf[len - 1] != '/'
+               && tmpbuf[len - 1] != '\\'
 #endif
               )
-               tokenbuf[len++] = '/';
-           if (len == 2 && tokenbuf[0] == '.')
+               tmpbuf[len++] = '/';
+           if (len == 2 && tmpbuf[0] == '.')
                seen_dot = 1;
-           (void)strcpy(tokenbuf + len, scriptname);
+           (void)strcpy(tmpbuf + len, scriptname);
 #endif  /* !VMS */
 
 #ifdef SEARCH_EXTS
-           len = strlen(tokenbuf);
+           len = strlen(tmpbuf);
            if (extidx > 0)     /* reset after previous loop */
                extidx = 0;
            do {
 #endif
-               DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
-               retval = PerlLIO_stat(tokenbuf,&statbuf);
+               DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf));
+               retval = PerlLIO_stat(tmpbuf,&statbuf);
 #ifdef SEARCH_EXTS
            } while (  retval < 0               /* not there */
                    && extidx>=0 && ext[extidx] /* try an extension? */
-                   && strcpy(tokenbuf+len, ext[extidx++])
+                   && strcpy(tmpbuf+len, ext[extidx++])
                );
 #endif
            if (retval < 0)
@@ -2546,28 +2552,31 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 #endif
                )
            {
-               xfound = tokenbuf;              /* bingo! */
+               xfound = tmpbuf;              /* bingo! */
                break;
            }
            if (!xfailed)
-               xfailed = savepv(tokenbuf);
+               xfailed = savepv(tmpbuf);
        }
 #ifndef DOSISH
        if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
 #endif
            seen_dot = 1;                       /* Disable message. */
-       if (!xfound) 
-           scriptname = NULL;
-/*         croak("Can't %s %s%s%s",
-                 (xfailed ? "execute" : "find"),
-                 (xfailed ? xfailed : scriptname),
-                 (xfailed ? "" : " on PATH"),
-                 (xfailed || seen_dot) ? "" : ", '.' not in PATH"); */
+       if (!xfound) {
+           if (flags & 1) {                    /* do or die? */
+               croak("Can't %s %s%s%s",
+                     (xfailed ? "execute" : "find"),
+                     (xfailed ? xfailed : scriptname),
+                     (xfailed ? "" : " on PATH"),
+                     (xfailed || seen_dot) ? "" : ", '.' not in PATH");
+           }
+           scriptname = Nullch;
+       }
        if (xfailed)
            Safefree(xfailed);
        scriptname = xfound;
     }
-    return scriptname;
+    return (scriptname ? savepv(scriptname) : Nullch);
 }
 
 
@@ -2854,4 +2863,4 @@ SV **
 get_specialsv_list(void)
 {
  return specialsv_list;
-}
\ No newline at end of file
+}
Unnamed repository; edit this file 'description' to name the repository.