This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 9109f8c..5336ad0 100644 (file)
--- a/util.c
+++ b/util.c
@@ -339,19 +339,19 @@ S_xstat(pTHX_ int flag)
 Malloc_t Perl_malloc (MEM_SIZE nbytes)
 {
     dTHXs;
-    return PerlMem_malloc(nbytes);
+    return (Malloc_t)PerlMem_malloc(nbytes);
 }
 
 Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size)
 {
     dTHXs;
-    return PerlMem_calloc(elements, size);
+    return (Malloc_t)PerlMem_calloc(elements, size);
 }
 
 Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes)
 {
     dTHXs;
-    return PerlMem_realloc(where, nbytes);
+    return (Malloc_t)PerlMem_realloc(where, nbytes);
 }
 
 Free_t   Perl_mfree (Malloc_t where)
@@ -883,18 +883,21 @@ Perl_ibcmp_locale(pTHX_ const char *s1, const char *s2, register I32 len)
 
 =for apidoc savepv
 
-Copy a string to a safe spot.  This does not use an SV.
+Perl's version of C<strdup()>. Returns a pointer to a newly allocated
+string which is a duplicate of C<pv>. The size of the string is
+determined by C<strlen()>. The memory allocated for the new string can
+be freed with the C<Safefree()> function.
 
 =cut
 */
 
 char *
-Perl_savepv(pTHX_ const char *sv)
+Perl_savepv(pTHX_ const char *pv)
 {
     register char *newaddr = Nullch;
-    if (sv) {
-       New(902,newaddr,strlen(sv)+1,char);
-       (void)strcpy(newaddr,sv);
+    if (pv) {
+       New(902,newaddr,strlen(pv)+1,char);
+       (void)strcpy(newaddr,pv);
     }
     return newaddr;
 }
@@ -904,22 +907,23 @@ Perl_savepv(pTHX_ const char *sv)
 /*
 =for apidoc savepvn
 
-Copy a string to a safe spot.  The C<len> indicates number of bytes to
-copy. If pointer is NULL allocate space for a string of size specified.
-This does not use an SV.
+Perl's version of what C<strndup()> would be if it existed. Returns a
+pointer to a newly allocated string which is a duplicate of the first
+C<len> bytes from C<pv>. The memory allocated for the new string can be
+freed with the C<Safefree()> function.
 
 =cut
 */
 
 char *
-Perl_savepvn(pTHX_ const char *sv, register I32 len)
+Perl_savepvn(pTHX_ const char *pv, register I32 len)
 {
     register char *newaddr;
 
     New(903,newaddr,len+1,char);
     /* Give a meaning to NULL pointer mainly for the use in sv_magic() */
-    if (sv) {
-       Copy(sv,newaddr,len,char);      /* might not be null terminated */
+    if (pv) {
+       Copy(pv,newaddr,len,char);      /* might not be null terminated */
        newaddr[len] = '\0';            /* is now */
     }
     else {
@@ -931,18 +935,18 @@ Perl_savepvn(pTHX_ const char *sv, register I32 len)
 /*
 =for apidoc savesharedpv
 
-Copy a string to a safe spot in memory shared between threads.
-This does not use an SV.
+A version of C<savepv()> which allocates the duplicate string in memory
+which is shared between threads.
 
 =cut
 */
 char *
-Perl_savesharedpv(pTHX_ const char *sv)
+Perl_savesharedpv(pTHX_ const char *pv)
 {
     register char *newaddr = Nullch;
-    if (sv) {
-       newaddr = PerlMemShared_malloc(strlen(sv)+1);
-       (void)strcpy(newaddr,sv);
+    if (pv) {
+       newaddr = (char*)PerlMemShared_malloc(strlen(pv)+1);
+       (void)strcpy(newaddr,pv);
     }
     return newaddr;
 }
@@ -1584,7 +1588,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
    *(s+(nlen+1+vlen)) = '\0'
 
 #ifdef USE_ENVIRON_ARRAY
-       /* VMS' and EPOC's my_setenv() is in vms.c and epoc.c */
+       /* VMS' my_setenv() is in vms.c */
 #if !defined(WIN32) && !defined(NETWARE)
 void
 Perl_my_setenv(pTHX_ char *nam, char *val)
@@ -1632,7 +1636,7 @@ Perl_my_setenv(pTHX_ char *nam, char *val)
     my_setenv_format(environ[i], nam, nlen, val, vlen);
 
 #else   /* PERL_USE_SAFE_PUTENV */
-#   if defined(__CYGWIN__)
+#   if defined(__CYGWIN__) || defined( EPOC)
     setenv(nam, val, 1);
 #   else
     char *new_env;
@@ -2192,7 +2196,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     return PerlIO_fdopen(p[This], mode);
 }
 #else
-#if defined(atarist)
+#if defined(atarist) || defined(EPOC)
 FILE *popen();
 PerlIO *
 Perl_my_popen(pTHX_ char *cmd, char *mode)
@@ -2275,7 +2279,7 @@ void
 Perl_dump_fds(pTHX_ char *s)
 {
     int fd;
-    struct stat tmpstatbuf;
+    Stat_t tmpstatbuf;
 
     PerlIO_printf(Perl_debug_log,"%s", s);
     for (fd = 0; fd < 32; fd++) {
@@ -2577,7 +2581,7 @@ Perl_pidgone(pTHX_ Pid_t pid, int status)
     return;
 }
 
-#if defined(atarist) || defined(OS2)
+#if defined(atarist) || defined(OS2) || defined(EPOC)
 int pclose();
 #ifdef HAS_FORK
 int                                    /* Cannot prototype with I32
@@ -2636,8 +2640,8 @@ Perl_same_dirent(pTHX_ char *a, char *b)
 {
     char *fa = strrchr(a,'/');
     char *fb = strrchr(b,'/');
-    struct stat tmpstatbuf1;
-    struct stat tmpstatbuf2;
+    Stat_t tmpstatbuf1;
+    Stat_t tmpstatbuf2;
     SV *tmpsv = sv_newmortal();
 
     if (fa)
@@ -3859,7 +3863,7 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 
 #else
 
-    struct stat statbuf;
+    Stat_t statbuf;
     int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
     int namelen, pathlen=0;
     DIR *dir;
@@ -3968,9 +3972,10 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
         Perl_croak(aTHX_ "Unstable directory path, "
                    "current directory changed unexpectedly");
     }
-#endif
 
     return TRUE;
+#endif
+
 #else
     return FALSE;
 #endif
@@ -4017,7 +4022,7 @@ Perl_new_vstring(pTHX_ char *s, SV *sv)
                 /* this is atoi() that tolerates underscores */
                 char *end = pos;
                 UV mult = 1;
-                if ( *(s-1) == '_') {
+                if ( s > pos && *(s-1) == '_') {
                      mult = 10;
                 }
                 while (--end >= s) {
@@ -4054,7 +4059,7 @@ Perl_new_vstring(pTHX_ char *s, SV *sv)
     return s;
 }
 
-#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) && defined(AF_INET) && defined(PF_INET) && defined(SOCK_DGRAM)
+#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) && defined(AF_INET) && defined(PF_INET) && defined(SOCK_DGRAM) && defined(HAS_SELECT)
 #   define EMULATE_SOCKETPAIR_UDP
 #endif
 
@@ -4198,7 +4203,9 @@ S_socketpair_udp (int fd[2]) {
         return -1;
     }
 }
+#endif /*  EMULATE_SOCKETPAIR_UDP */
 
+#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) && defined(AF_INET) && defined(PF_INET) 
 int
 Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
     /* Stevens says that family must be AF_LOCAL, protocol 0.
@@ -4277,7 +4284,7 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
     return 0;
 
   abort_tidy_up_and_fail:
-    errno = ECONNABORTED; /* I hope this is portable and appropriate.  */
+  errno = ECONNABORTED; /* I hope this is portable and appropriate.  */
   tidy_up_and_fail:
     {
         int save_errno = errno;
@@ -4291,13 +4298,16 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
         return -1;
     }
 }
-#endif /* !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) */
-#ifdef HAS_SOCKETPAIR
+#else
 /* In any case have a stub so that there's code corresponding
  * to the my_socketpair in global.sym. */
 int
 Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
+#ifdef HAS_SOCKETPAIR
     return socketpair(family, type, protocol, fd);
+#else
+    return -1;
+#endif
 }
 #endif
 
@@ -4348,14 +4358,3 @@ Perl_sv_nounlocking(pTHX_ SV *sv)
 {
 }
 
-void
-Perl_reentrant_init(pTHX)
-{
-#ifdef USE_REENTRANT_API
-    New(31337, PL_reentrant_buffer, 1, REENTBUF);
-    New(31337, PL_reentrant_buffer->tmbuf, 1, struct tm);
-#endif
-}
-
-
-