This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Extra paranoia from Nicholas Clark.
[perl5.git] / pp_sys.c
index 87231ee..5955b14 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -852,7 +852,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 ) ;
            }
@@ -984,18 +984,7 @@ PP(pp_sselect)
     }
 
 /* little endians can use vecs directly */
-#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-#  if SELECT_MIN_BITS > 1
-    /* If SELECT_MIN_BITS is greater than one we most probably will want
-     * to align the sizes with SELECT_MIN_BITS/8 because for example
-     * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
-     * UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates
-     * on (sets/tests/clears bits) is 32 bits.  */
-    growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
-#  else
-    growsize = sizeof(fd_set);
-#  endif
-# else
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
 #  ifdef NFDBITS
 
 #    ifndef NBBY
@@ -1006,10 +995,20 @@ PP(pp_sselect)
 #  else
     masksize = sizeof(long);   /* documented int, everyone seems to use long */
 #  endif
-    growsize = maxlen + (masksize - (maxlen % masksize));
     Zero(&fd_sets[0], 4, char*);
 #endif
 
+#  if SELECT_MIN_BITS > 1
+    /* If SELECT_MIN_BITS is greater than one we most probably will want
+     * to align the sizes with SELECT_MIN_BITS/8 because for example
+     * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
+     * UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates
+     * on (sets/tests/clears bits) is 32 bits.  */
+    growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
+#  else
+    growsize = sizeof(fd_set);
+#  endif
+
     sv = SP[4];
     if (SvOK(sv)) {
        value = SvNV(sv);
@@ -1358,10 +1357,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))
@@ -1372,7 +1371,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);
@@ -1444,10 +1443,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))
@@ -1681,10 +1680,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;
@@ -2732,7 +2731,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");
@@ -2761,7 +2760,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;
        }
@@ -2776,7 +2775,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;
        }
     }
@@ -3322,7 +3321,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);
@@ -3423,7 +3422,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 {
@@ -4619,9 +4618,9 @@ 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;
@@ -4728,9 +4727,9 @@ 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;
@@ -4816,9 +4815,9 @@ 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;
@@ -4899,9 +4898,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;