A couple of File::Path tests require unix syntax on VMS.

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

diff --git a/pp_sys.c b/pp_sys.c
index eab721a..3cef694 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,7 +1,7 @@
 /*    pp_sys.c
  *
- *    Copyright (C) 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ *    2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -437,6 +437,7 @@ PP(pp_warn)
     else if (SP == MARK) {
        tmpsv = &PL_sv_no;
        EXTEND(SP, 1);
+       SP = MARK + 1;
     }
     else {
        tmpsv = TOPs;
@@ -537,10 +538,15 @@ PP(pp_open)
 
     if (!isGV(gv))
        DIE(aTHX_ PL_no_usym, "filehandle");
+
     if ((io = GvIOp(gv))) {
        MAGIC *mg;
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
+       if (IoDIRP(io) && ckWARN2(WARN_IO, WARN_DEPRECATED))
+           Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+                   "Opening dirhandle %s also as a file", GvENAME(gv));
+
        mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            /* Method's args are same as ours ... */
@@ -707,8 +713,12 @@ PP(pp_umask)
     Mode_t anum;
 
     if (MAXARG < 1) {
-       anum = PerlLIO_umask(0);
-       (void)PerlLIO_umask(anum);
+       anum = PerlLIO_umask(022);
+       /* setting it to 022 between the two calls to umask avoids
+        * to have a window where the umask is set to 0 -- meaning
+        * that another thread could create world-writeable files. */
+       if (anum != 022)
+           (void)PerlLIO_umask(anum);
     }
     else
        anum = PerlLIO_umask(POPi);
@@ -840,7 +850,7 @@ PP(pp_tie)
        /* Not clear why we don't call call_method here too.
         * perhaps to get different error message ?
         */
-       stash = gv_stashsv(*MARK, FALSE);
+       stash = gv_stashsv(*MARK, 0);
        if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
            DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
                 methname, SVfARG(*MARK));
@@ -942,7 +952,7 @@ PP(pp_dbmopen)
 
     HV * const hv = (HV*)POPs;
     SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
-    stash = gv_stashsv(sv, FALSE);
+    stash = gv_stashsv(sv, 0);
     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
        PUTBACK;
        require_pv("AnyDBM_File.pm");
@@ -2818,12 +2828,8 @@ PP(pp_stat)
                         PL_laststatval = 
                             PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
                     } else if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
                         PL_laststatval =
-                            PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache);
-#else
-                        DIE(aTHX_ PL_no_func, "dirfd");
-#endif
+                            PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
                     } else {
                         PL_laststatval = -1;
                     }
@@ -3337,7 +3343,7 @@ PP(pp_fttext)
 
 #if defined(DOSISH) || defined(USEMYBINMODE)
     /* ignore trailing ^Z on short files */
-    if (len && len < sizeof(tbuf) && tbuf[len-1] == 26)
+    if (len && len < (I32)sizeof(tbuf) && tbuf[len-1] == 26)
        --len;
 #endif
 
@@ -3406,7 +3412,7 @@ PP(pp_chdir)
             gv = (GV*)SvRV(sv);
         }
         else {
-           tmps = SvPVx_nolen_const(sv);
+           tmps = SvPV_nolen_const(sv);
        }
     }
 
@@ -3437,15 +3443,10 @@ PP(pp_chdir)
 #ifdef HAS_FCHDIR
        IO* const io = GvIO(gv);
        if (io) {
-           if (IoIFP(io)) {
-               PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
-           }
-           else if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
-               PUSHi(fchdir(dirfd(IoDIRP(io))) >= 0);
-#else
-               DIE(aTHX_ PL_no_func, "dirfd");
-#endif
+           if (IoDIRP(io)) {
+               PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
+           } else if (IoIFP(io)) {
+                PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
            }
            else {
                if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
@@ -3765,6 +3766,9 @@ PP(pp_open_dir)
     if (!io)
        goto nope;
 
+    if ((IoIFP(io) || IoOFP(io)) && ckWARN2(WARN_IO, WARN_DEPRECATED))
+       Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+               "Opening filehandle %s also as a directory", GvENAME(gv));
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -4651,9 +4655,9 @@ PP(pp_ghostent)
        const int addrtype = POPi;
        SV * const addrsv = POPs;
        STRLEN addrlen;
-       Netdb_host_t addr = (Netdb_host_t) SvPVbyte(addrsv, addrlen);
+       const char *addr = (char *)SvPVbyte(addrsv, addrlen);
 
-       hent = PerlSock_gethostbyaddr((const char*)addr, (Netdb_hlen_t) addrlen, addrtype);
+       hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
 #else
        DIE(aTHX_ PL_no_sock_func, "gethostbyaddr");
 #endif