# 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
struct group *getgrgid (Gid_t);
# endif
# ifdef HAS_GETGRENT
+#ifndef getgrent
struct group *getgrent (void);
+#endif
# endif
#endif
}
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 ) ;
}
}
/* 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
# 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);
RETURN;
}
if (!gv || do_eof(gv)) { /* make sure we have fp with something */
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED) && IoTYPE(io) != IoTYPE_WRONLY)
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)
+ && (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)))
report_evil_fh(gv, io, PL_op->op_type);
RETPUSHUNDEF;
}
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))
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);
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))
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;
PP(pp_sockpair)
{
-#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM))
+#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))
dSP;
GV *gv1;
GV *gv2;
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");
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;
}
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;
}
}
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);
if (SP - MARK == 1) {
TAINT_PROPER("system");
}
- else if (ckWARN(WARN_TAINT)) {
- Perl_warner(aTHX_ WARN_TAINT,
+ else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED),
"Use of tainted arguments in %s is deprecated", "system");
}
}
if (SP - MARK == 1) {
TAINT_PROPER("exec");
}
- else if (ckWARN(WARN_TAINT)) {
- Perl_warner(aTHX_ WARN_TAINT,
+ else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED),
"Use of tainted arguments in %s is deprecated", "exec");
}
}
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;
#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) {
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;
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());
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();
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;
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
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();
projects / p5sagit/p5-mst-13.2.git / blobdiff