More tests for \g errors in regular expressions

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

diff --git a/pp_sys.c b/pp_sys.c
index 44adca6..deed9ff 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -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 ... */
@@ -2822,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;
                     }
@@ -3341,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
 
@@ -3410,7 +3412,7 @@ PP(pp_chdir)
             gv = (GV*)SvRV(sv);
         }
         else {
-           tmps = SvPVx_nolen_const(sv);
+           tmps = SvPV_nolen_const(sv);
        }
     }
 
@@ -3441,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))
@@ -3769,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)))
@@ -4008,7 +4008,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 +4036,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 +4067,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 +4195,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 +4661,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