minor Tie::File test patch to make win32 happier, from mjd.

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

diff --git a/pp_sys.c b/pp_sys.c
index 593fd6c..941760b 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -80,7 +80,11 @@ extern int h_errno;
 #  endif
 # endif
 # ifdef HAS_GETPWENT
+#ifndef getpwent
   struct passwd *getpwent (void);
+#elif defined (VMS) && defined (my_getpwent)
+  struct passwd *Perl_my_getpwent (void);
+#endif
 # endif
 #endif
 
@@ -92,7 +96,9 @@ extern int h_errno;
     struct group *getgrgid (Gid_t);
 # endif
 # ifdef HAS_GETGRENT
+#ifndef getgrent
     struct group *getgrent (void);
+#endif
 # endif
 #endif
 
@@ -852,7 +858,7 @@ PP(pp_untie)
             }
            else if (ckWARN(WARN_UNTIE)) {
               if (mg && SvREFCNT(obj) > 1)
-                 Perl_warner(aTHX_ WARN_UNTIE,
+                 Perl_warner(aTHX_ packWARN(WARN_UNTIE),
                      "untie attempted while %"UVuf" inner references still exist",
                       (UV)SvREFCNT(obj) - 1 ) ;
            }
@@ -1357,10 +1363,10 @@ PP(pp_leavewrite)
                    name = SvPV_nolen(sv);
                }
                if (name && *name)
-                   Perl_warner(aTHX_ WARN_IO,
+                   Perl_warner(aTHX_ packWARN(WARN_IO),
                                "Filehandle %s opened only for input", name);
                else
-                   Perl_warner(aTHX_ WARN_IO,
+                   Perl_warner(aTHX_ packWARN(WARN_IO),
                                "Filehandle opened only for input");
            }
            else if (ckWARN(WARN_CLOSED))
@@ -1371,7 +1377,7 @@ PP(pp_leavewrite)
     else {
        if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
            if (ckWARN(WARN_IO))
-               Perl_warner(aTHX_ WARN_IO, "page overflow");
+               Perl_warner(aTHX_ packWARN(WARN_IO), "page overflow");
        }
        if (!do_print(PL_formtarget, fp))
            PUSHs(&PL_sv_no);
@@ -1443,10 +1449,10 @@ PP(pp_prtf)
                    name = SvPV_nolen(sv);
                }
                if (name && *name)
-                   Perl_warner(aTHX_ WARN_IO,
+                   Perl_warner(aTHX_ packWARN(WARN_IO),
                                "Filehandle %s opened only for input", name);
                else
-                   Perl_warner(aTHX_ WARN_IO,
+                   Perl_warner(aTHX_ packWARN(WARN_IO),
                                "Filehandle opened only for input");
            }
            else if (ckWARN(WARN_CLOSED))
@@ -1680,10 +1686,10 @@ PP(pp_sysread)
                name = SvPV_nolen(sv);
            }
            if (name && *name)
-               Perl_warner(aTHX_ WARN_IO,
+               Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Filehandle %s opened only for output", name);
            else
-               Perl_warner(aTHX_ WARN_IO,
+               Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Filehandle opened only for output");
        }
        goto say_undef;
@@ -2731,7 +2737,7 @@ PP(pp_stat)
        if (PL_op->op_type == OP_LSTAT) {
            if (gv != PL_defgv) {
                if (ckWARN(WARN_IO))
-                   Perl_warner(aTHX_ WARN_IO,
+                   Perl_warner(aTHX_ packWARN(WARN_IO),
                        "lstat() on filehandle %s", GvENAME(gv));
            } else if (PL_laststype != OP_LSTAT)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
@@ -2760,7 +2766,7 @@ PP(pp_stat)
        else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
            gv = (GV*)SvRV(sv);
            if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
-               Perl_warner(aTHX_ WARN_IO,
+               Perl_warner(aTHX_ packWARN(WARN_IO),
                        "lstat() on filehandle %s", GvENAME(gv));
            goto do_fstat;
        }
@@ -2775,7 +2781,7 @@ PP(pp_stat)
            PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
        if (PL_laststatval < 0) {
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
-               Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "stat");
+               Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
            max = 0;
        }
     }
@@ -3321,7 +3327,7 @@ PP(pp_fttext)
        sv_setpv(PL_statname, SvPV(sv, n_a));
        if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
-               Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
+               Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
            RETPUSHUNDEF;
        }
        PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
@@ -3422,7 +3428,7 @@ PP(pp_chdir)
            )
         {
             if( MAXARG == 1 )
-                deprecate_old("chdir('') or chdir(undef) as chdir()");
+                deprecate("chdir('') or chdir(undef) as chdir()");
             tmps = SvPV(*svp, n_a);
         }
         else {
@@ -4618,21 +4624,23 @@ PP(pp_ghostent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
-    struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
-    struct hostent *PerlSock_gethostbyname(Netdb_name_t);
-    struct hostent *PerlSock_gethostent(void);
+    struct hostent *gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
+    struct hostent *gethostbyname(Netdb_name_t);
+    struct hostent *gethostent(void);
 #endif
     struct hostent *hent;
     unsigned long len;
     STRLEN n_a;
 
     EXTEND(SP, 10);
-    if (which == OP_GHBYNAME)
+    if (which == OP_GHBYNAME) {
 #ifdef HAS_GETHOSTBYNAME
-       hent = PerlSock_gethostbyname(POPpbytex);
+        char* name = POPpbytex;
+       hent = PerlSock_gethostbyname(name);
 #else
        DIE(aTHX_ PL_no_sock_func, "gethostbyname");
 #endif
+    }
     else if (which == OP_GHBYADDR) {
 #ifdef HAS_GETHOSTBYADDR
        int addrtype = POPi;
@@ -4653,8 +4661,14 @@ PP(pp_ghostent)
 #endif
 
 #ifdef HOST_NOT_FOUND
-    if (!hent)
-       STATUS_NATIVE_SET(h_errno);
+       if (!hent) {
+#ifdef USE_REENTRANT_API
+#   ifdef USE_GETHOSTENT_ERRNO
+           h_errno = PL_reentrant_buffer->_gethostent_errno;
+#   endif
+#endif
+           STATUS_NATIVE_SET(h_errno);
+       }
 #endif
 
     if (GIMME != G_ARRAY) {
@@ -4727,19 +4741,21 @@ PP(pp_gnetent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
-    struct netent *PerlSock_getnetbyaddr(Netdb_net_t, int);
-    struct netent *PerlSock_getnetbyname(Netdb_name_t);
-    struct netent *PerlSock_getnetent(void);
+    struct netent *getnetbyaddr(Netdb_net_t, int);
+    struct netent *getnetbyname(Netdb_name_t);
+    struct netent *getnetent(void);
 #endif
     struct netent *nent;
     STRLEN n_a;
 
-    if (which == OP_GNBYNAME)
+    if (which == OP_GNBYNAME){
 #ifdef HAS_GETNETBYNAME
-       nent = PerlSock_getnetbyname(POPpbytex);
+        char *name = POPpbytex;
+       nent = PerlSock_getnetbyname(name);
 #else
         DIE(aTHX_ PL_no_sock_func, "getnetbyname");
 #endif
+    }
     else if (which == OP_GNBYADDR) {
 #ifdef HAS_GETNETBYADDR
        int addrtype = POPi;
@@ -4756,6 +4772,17 @@ PP(pp_gnetent)
         DIE(aTHX_ PL_no_sock_func, "getnetent");
 #endif
 
+#ifdef HOST_NOT_FOUND
+       if (!nent) {
+#ifdef USE_REENTRANT_API
+#   ifdef USE_GETNETENT_ERRNO
+            h_errno = PL_reentrant_buffer->_getnetent_errno;
+#   endif
+#endif
+           STATUS_NATIVE_SET(h_errno);
+       }
+#endif
+
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
        PUSHs(sv = sv_newmortal());
@@ -4815,25 +4842,29 @@ PP(pp_gprotoent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
-    struct protoent *PerlSock_getprotobyname(Netdb_name_t);
-    struct protoent *PerlSock_getprotobynumber(int);
-    struct protoent *PerlSock_getprotoent(void);
+    struct protoent *getprotobyname(Netdb_name_t);
+    struct protoent *getprotobynumber(int);
+    struct protoent *getprotoent(void);
 #endif
     struct protoent *pent;
     STRLEN n_a;
 
-    if (which == OP_GPBYNAME)
+    if (which == OP_GPBYNAME) {
 #ifdef HAS_GETPROTOBYNAME
-       pent = PerlSock_getprotobyname(POPpbytex);
+        char* name = POPpbytex;
+       pent = PerlSock_getprotobyname(name);
 #else
        DIE(aTHX_ PL_no_sock_func, "getprotobyname");
 #endif
-    else if (which == OP_GPBYNUMBER)
+    }
+    else if (which == OP_GPBYNUMBER) {
 #ifdef HAS_GETPROTOBYNUMBER
-       pent = PerlSock_getprotobynumber(POPi);
+        int number = POPi;
+       pent = PerlSock_getprotobynumber(number);
 #else
-    DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
+       DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
 #endif
+    }
     else
 #ifdef HAS_GETPROTOENT
        pent = PerlSock_getprotoent();
@@ -4898,9 +4929,9 @@ PP(pp_gservent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
-    struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t);
-    struct servent *PerlSock_getservbyport(int, Netdb_name_t);
-    struct servent *PerlSock_getservent(void);
+    struct servent *getservbyname(Netdb_name_t, Netdb_name_t);
+    struct servent *getservbyport(int, Netdb_name_t);
+    struct servent *getservent(void);
 #endif
     struct servent *sent;
     STRLEN n_a;
@@ -5154,10 +5185,16 @@ PP(pp_gpwent)
 
     switch (which) {
     case OP_GPWNAM:
-       pwent  = getpwnam(POPpbytex);
-       break;
+      {
+       char* name = POPpbytex;
+       pwent  = getpwnam(name);
+      }
+      break;
     case OP_GPWUID:
-       pwent = getpwuid((Uid_t)POPi);
+      {
+       Uid_t uid = POPi;
+       pwent = getpwuid(uid);
+      }
        break;
     case OP_GPWENT:
 #   ifdef HAS_GETPWENT
@@ -5354,10 +5391,14 @@ PP(pp_ggrent)
     struct group *grent;
     STRLEN n_a;
 
-    if (which == OP_GGRNAM)
-       grent = (struct group *)getgrnam(POPpbytex);
-    else if (which == OP_GGRGID)
-       grent = (struct group *)getgrgid(POPi);
+    if (which == OP_GGRNAM) {
+        char* name = POPpbytex;
+       grent = (struct group *)getgrnam(name);
+    }
+    else if (which == OP_GGRGID) {
+        Gid_t gid = POPi;
+       grent = (struct group *)getgrgid(gid);
+    }
     else
 #ifdef HAS_GETGRENT
        grent = (struct group *)getgrent();