X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=6aa86455e89cda9af85587a5f16c8c4cd8cc7914;hb=503d18c3058e98ddac11e71da254c0d23141a243;hp=5693d5063c015c1761ea8ec5634ec5d02bee40ef;hpb=c08d693782d39895d445f7f2825c1f8240fc9f5a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index 5693d50..6aa8645 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -297,22 +297,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 
     return res;
 }
-#   define PERL_EFF_ACCESS(p,f) (emulate_eaccess((p), (f)))
-#endif
-
-#if !defined(PERL_EFF_ACCESS)
-/* With it or without it: anyway you get a warning: either that
-   it is unused, or it is declared static and never defined.
- */
-STATIC int
-S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
-{
-    PERL_UNUSED_ARG(path);
-    PERL_UNUSED_ARG(mode);
-    Perl_croak(aTHX_ "switching effective uid is not implemented");
-    /*NOTREACHED*/
-    return -1;
-}
+#   define PERL_EFF_ACCESS(p,f) (S_emulate_eaccess(aTHX_ (p), (f)))
 #endif
 
 PP(pp_backtick)
@@ -478,7 +463,7 @@ PP(pp_die)
     }
     else {
 	tmpsv = TOPs;
-        tmps = SvROK(tmpsv) ? NULL : SvPV_const(tmpsv, len);
+        tmps = SvROK(tmpsv) ? (const char *)NULL : SvPV_const(tmpsv, len);
     }
     if (!tmps || !len) {
 	SV * const error = ERRSV;
@@ -538,10 +523,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 ... */
@@ -2022,7 +2012,12 @@ PP(pp_eof)
 		    IoLINES(io) = 0;
 		    IoFLAGS(io) &= ~IOf_START;
 		    do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
-		    sv_setpvn(GvSV(gv), "-", 1);
+		    if ( GvSV(gv) ) {
+			sv_setpvn(GvSV(gv), "-", 1);
+		    }
+		    else {
+			GvSV(gv) = newSVpvn("-", 1);
+		    }
 		    SvSETMAGIC(GvSV(gv));
 		}
 		else if (!nextargv(gv))
@@ -2823,12 +2818,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;
                     }
@@ -3411,7 +3402,7 @@ PP(pp_chdir)
             gv = (GV*)SvRV(sv);
         }
         else {
-	    tmps = SvPVx_nolen_const(sv);
+	    tmps = SvPV_nolen_const(sv);
 	}
     }
 
@@ -3443,11 +3434,7 @@ PP(pp_chdir)
 	IO* const io = GvIO(gv);
 	if (io) {
 	    if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
-		PUSHi(fchdir(dirfd(IoDIRP(io))) >= 0);
-#else
-		DIE(aTHX_ PL_no_func, "dirfd");
-#endif
+		PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
 	    } else if (IoIFP(io)) {
                 PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
 	    }
@@ -3769,6 +3756,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)))
@@ -4008,7 +3998,7 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
     dVAR; dSP; dTARGET;
     Pid_t childpid;
     int argflags;
@@ -4036,7 +4026,7 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
     dVAR; dSP; dTARGET;
     const int optype = POPi;
     const Pid_t pid = TOPi;
@@ -4067,6 +4057,11 @@ PP(pp_waitpid)
 PP(pp_system)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+#if defined(__LIBCATAMOUNT__)
+    PL_statusvalue = -1;
+    SP = ORIGMARK;
+    XPUSHi(-1);
+#else
     I32 value;
     int result;
 
@@ -4190,7 +4185,8 @@ PP(pp_system)
     do_execfree();
     SP = ORIGMARK;
     XPUSHi(result ? value : STATUS_CURRENT);
-#endif /* !FORK or VMS */
+#endif /* !FORK or VMS or OS/2 */
+#endif
     RETURN;
 }
 
@@ -4655,9 +4651,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
@@ -5223,7 +5219,7 @@ PP(pp_gpwent)
 #   ifdef PWGECOS
 	PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0)));
 #   else
-	PUSHs(sv_mortalcopy(&PL_sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   endif
 #   ifndef INCOMPLETE_TAINTS
 	/* pw_gecos is tainted because user himself can diddle with it. */