This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
note about AVf_*
[perl5.git] / pp_sys.c
index b63101d..5271a86 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -187,6 +187,10 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 #  include <sys/access.h>
 #endif
 
+#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
+#  define FD_CLOEXEC 1         /* NeXT needs this */
+#endif
+
 #undef PERL_EFF_ACCESS_R_OK    /* EFFective uid/gid ACCESS R_OK */
 #undef PERL_EFF_ACCESS_W_OK
 #undef PERL_EFF_ACCESS_X_OK
@@ -230,7 +234,7 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
        || defined(HAS_SETREGID) || defined(HAS_SETRESGID))
 /* The Hard Way. */
 STATIC int
-S_emulate_eaccess(pTHX_ const char* path, int mode)
+S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 {
     Uid_t ruid = getuid();
     Uid_t euid = geteuid();
@@ -295,7 +299,7 @@ S_emulate_eaccess(pTHX_ const char* path, int mode)
 
 #if !defined(PERL_EFF_ACCESS_R_OK)
 STATIC int
-S_emulate_eaccess(pTHX_ const char* path, int mode)
+S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 {
     Perl_croak(aTHX_ "switching effective uid is not implemented");
     /*NOTREACHED*/
@@ -816,10 +820,17 @@ PP(pp_untie)
     if (ckWARN(WARN_UNTIE)) {
         MAGIC * mg ;
         if (mg = SvTIED_mg(sv, how)) {
+#ifdef IV_IS_QUAD
+            if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
+               Perl_warner(aTHX_ WARN_UNTIE,
+                   "untie attempted while %" PERL_PRIu64 " inner references still exist",
+                   (UV)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
+#else
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
                Perl_warner(aTHX_ WARN_UNTIE,
                    "untie attempted while %lu inner references still exist",
                    (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
+#endif
         }
     }
  
@@ -1554,8 +1565,8 @@ PP(pp_sysread)
            length = -1;
     }
     if (length < 0) {
-       if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
-           || IoIFP(io) == PerlIO_stderr())
+       if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+           || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
        {
            SV* sv = sv_newmortal();
            gv_efullname3(sv, gv, Nullch);
@@ -1660,6 +1671,7 @@ PP(pp_send)
        else
 #endif
        {
+           /* See the note at doio.c:do_print about filesize limits. --jhi */
            length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
                                   buffer+offset, length);
        }
@@ -1757,7 +1769,7 @@ PP(pp_sysseek)
     djSP;
     GV *gv;
     int whence = POPi;
-    Off_t offset = POPl;
+    Off_t offset = (Off_t)SvIVx(POPs);
     MAGIC *mg;
 
     gv = PL_last_in_gv = (GV*)POPs;
@@ -1886,7 +1898,7 @@ PP(pp_ioctl)
     }
     else {
        retval = SvIV(argsv);
-       s = (char*)retval;              /* ouch */
+       s = (char*)PTR_CAST retval;             /* ouch */
     }
 
     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
@@ -2465,30 +2477,30 @@ PP(pp_stat)
     if (max) {
        EXTEND(SP, max);
        EXTEND_MORTAL(max);
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_dev)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ino)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mode)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_nlink)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_uid)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_gid)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
 #ifdef USE_STAT_RDEV
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_rdev)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
 #else
        PUSHs(sv_2mortal(newSVpvn("", 0)));
 #endif
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_size)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
 #ifdef BIG_TIME
-       PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_atime)));
-       PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_mtime)));
-       PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_ctime)));
+       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime)));
+       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
+       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
 #else
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_atime)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mtime)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ctime)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
 #endif
 #ifdef USE_STAT_BLOCKS
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blksize)));
-       PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blocks)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_blksize)));
+       PUSHs(sv_2mortal(newSViv(PL_statcache.st_blocks)));
 #else
        PUSHs(sv_2mortal(newSVpvn("", 0)));
        PUSHs(sv_2mortal(newSVpvn("", 0)));
@@ -2711,7 +2723,7 @@ PP(pp_ftmtime)
     djSP; dTARGET;
     if (result < 0)
        RETPUSHUNDEF;
-    PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_mtime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 );
     RETURN;
 }
 
@@ -2721,7 +2733,7 @@ PP(pp_ftatime)
     djSP; dTARGET;
     if (result < 0)
        RETPUSHUNDEF;
-    PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_atime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 );
     RETURN;
 }
 
@@ -2731,7 +2743,7 @@ PP(pp_ftctime)
     djSP; dTARGET;
     if (result < 0)
        RETPUSHUNDEF;
-    PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_ctime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 );
     RETURN;
 }
 
@@ -3757,21 +3769,21 @@ PP(pp_getpgrp)
 {
 #ifdef HAS_GETPGRP
     djSP; dTARGET;
-    int pid;
-    I32 value;
+    Pid_t pid;
+    Pid_t pgrp;
 
     if (MAXARG < 1)
        pid = 0;
     else
        pid = SvIVx(POPs);
 #ifdef BSD_GETPGRP
-    value = (I32)BSD_GETPGRP(pid);
+    pgrp = (I32)BSD_GETPGRP(pid);
 #else
     if (pid != 0 && pid != getpid())
        DIE(aTHX_ "POSIX getpgrp can't take an argument");
-    value = (I32)getpgrp();
+    pgrp = getpgrp();
 #endif
-    XPUSHi(value);
+    XPUSHi(pgrp);
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpgrp()");
@@ -3782,8 +3794,8 @@ PP(pp_setpgrp)
 {
 #ifdef HAS_SETPGRP
     djSP; dTARGET;
-    int pgrp;
-    int pid;
+    Pid_t pgrp;
+    Pid_t pid;
     if (MAXARG < 2) {
        pgrp = 0;
        pid = 0;
@@ -3932,25 +3944,25 @@ PP(pp_gmtime)
        if (!tmbuf)
            RETPUSHUNDEF;
        tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
-                      dayname[tmbuf->tm_wday],
-                      monname[tmbuf->tm_mon],
-                      tmbuf->tm_mday,
-                      tmbuf->tm_hour,
-                      tmbuf->tm_min,
-                      tmbuf->tm_sec,
-                      tmbuf->tm_year + 1900);
+                           dayname[tmbuf->tm_wday],
+                           monname[tmbuf->tm_mon],
+                           tmbuf->tm_mday,
+                           tmbuf->tm_hour,
+                           tmbuf->tm_min,
+                           tmbuf->tm_sec,
+                           tmbuf->tm_year + 1900);
        PUSHs(sv_2mortal(tsv));
     }
     else if (tmbuf) {
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
-       PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_mon)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_year)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_wday)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_yday)));
+       PUSHs(sv_2mortal(newSViv(tmbuf->tm_isdst)));
     }
     RETURN;
 }
@@ -3965,7 +3977,7 @@ PP(pp_alarm)
     EXTEND(SP, 1);
     if (anum < 0)
        RETPUSHUNDEF;
-    PUSHi((I32)anum);
+    PUSHi(anum);
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "Unsupported function alarm");
@@ -4732,7 +4744,7 @@ PP(pp_gpwent)
 PP(pp_spwent)
 {
     djSP;
-#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN)
+#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
     setpwent();
 #   ifdef HAS_SETSPENT
     setspent();
@@ -4993,7 +5005,7 @@ fcntl_emulate_flock(int fd, int operation)
        return -1;
     }
     flock.l_whence = SEEK_SET;
-    flock.l_start = flock.l_len = 0L;
+    flock.l_start = flock.l_len = (Off_t)0;
  
     return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
 }