X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=73326035487184e0f9879c94318a0970397836cc;hb=60441da28683c126db80bde5b2b8b45460537070;hp=c6e407b34017cb8343f2766dca854e4feec48ca0;hpb=595ae48196d4b0901d4a1aee37333fa960a6031f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index c6e407b..7332603 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -70,8 +70,10 @@ extern int h_errno;
 # ifdef I_PWD
 #  include <pwd.h>
 # else
+#  if !defined(VMS)
     struct passwd *getpwnam (char *);
     struct passwd *getpwuid (Uid_t);
+#  endif
 # endif
 # ifdef HAS_GETPWENT
   struct passwd *getpwent (void);
@@ -508,7 +510,7 @@ PP(pp_open)
     if (GvIOp(gv))
 	IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
-    if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	/* Method's args are same as ours ... */
 	/* ... except handle is replaced by the object */
 	*MARK-- = SvTIED_obj((SV*)gv, mg);
@@ -551,7 +553,7 @@ PP(pp_close)
     else
 	gv = (GV*)POPs;
 
-    if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	PUTBACK;
@@ -633,7 +635,7 @@ PP(pp_fileno)
 	RETPUSHUNDEF;
     gv = (GV*)POPs;
 
-    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	PUTBACK;
@@ -701,7 +703,7 @@ PP(pp_binmode)
 
     gv = (GV*)POPs;
 
-    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	if (discp)
@@ -742,7 +744,7 @@ PP(pp_tie)
     SV *sv;
     I32 markoff = MARK - PL_stack_base;
     char *methname;
-    int how = 'P';
+    int how = PERL_MAGIC_tied;
     U32 items;
     STRLEN n_a;
 
@@ -761,11 +763,11 @@ PP(pp_tie)
 	    }
 #endif
 	    methname = "TIEHANDLE";
-	    how = 'q';
+	    how = PERL_MAGIC_tiedscalar;
 	    break;
 	default:
 	    methname = "TIESCALAR";
-	    how = 'q';
+	    how = PERL_MAGIC_tiedscalar;
 	    break;
     }
     items = SP - MARK++;
@@ -821,7 +823,8 @@ PP(pp_untie)
 {
     dSP;
     SV *sv = POPs;
-    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
+		? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
         MAGIC * mg ;
         if ((mg = SvTIED_mg(sv, how))) {
@@ -854,7 +857,8 @@ PP(pp_tied)
 {
     dSP;
     SV *sv = POPs;
-    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
+		? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
     MAGIC *mg;
 
     if ((mg = SvTIED_mg(sv, how))) {
@@ -917,8 +921,8 @@ PP(pp_dbmopen)
     }
 
     if (sv_isobject(TOPs)) {
-	sv_unmagic((SV *) hv, 'P');
-	sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
+	sv_unmagic((SV *) hv, PERL_MAGIC_tied);
+	sv_magic((SV*)hv, TOPs, PERL_MAGIC_tied, Nullch, 0);
     }
     LEAVE;
     RETURN;
@@ -1125,7 +1129,7 @@ PP(pp_getc)
     else
 	gv = (GV*)POPs;
 
-    if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	I32 gimme = GIMME_V;
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
@@ -1382,7 +1386,7 @@ PP(pp_prtf)
     else
 	gv = PL_defoutgv;
 
-    if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	if (MARK == ORIGMARK) {
 	    MEXTEND(SP, 1);
 	    ++MARK;
@@ -1501,7 +1505,7 @@ PP(pp_sysread)
 
     gv = (GV*)*++MARK;
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
-	(mg = SvTIED_mg((SV*)gv, 'q')))
+	(mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar)))
     {
 	SV *sv;
 	
@@ -1531,7 +1535,7 @@ PP(pp_sysread)
     io = GvIO(gv);
     if (!io || !IoIFP(io))
 	goto say_undef;
-    if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTE) {
+    if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
 	buffer = SvPVutf8_force(bufsv, blen);
 	/* UTF8 may not have been set if they are all low bytes */
 	SvUTF8_on(bufsv);
@@ -1561,6 +1565,10 @@ PP(pp_sysread)
 			  (struct sockaddr *)namebuf, &bufsize);
 	if (count < 0)
 	    RETPUSHUNDEF;
+#ifdef EPOC
+        /* Bogus return without padding */
+	bufsize = sizeof (struct sockaddr_in);
+#endif
 	SvCUR_set(bufsv, count);
 	*SvEND(bufsv) = '\0';
 	(void)SvPOK_only(bufsv);
@@ -1634,8 +1642,7 @@ PP(pp_sysread)
 	    count = -1;
     }
     if (count < 0) {
-	if ((IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
-	    || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
+	if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
 	{
 	    /* integrate with report_evil_fh()? */
 	    char *name = NULL;
@@ -1656,7 +1663,7 @@ PP(pp_sysread)
     SvCUR_set(bufsv, count+(buffer - SvPVX(bufsv)));
     *SvEND(bufsv) = '\0';
     (void)SvPOK_only(bufsv);
-    if (fp_utf8 && !IN_BYTE) {
+    if (fp_utf8 && !IN_BYTES) {
 	/* Look at utf8 we got back and count the characters */
 	char *bend = buffer + count;
 	while (buffer < bend) {
@@ -1724,7 +1731,9 @@ PP(pp_send)
     MAGIC *mg;
 
     gv = (GV*)*++MARK;
-    if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if (PL_op->op_type == OP_SYSWRITE
+		&& (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar)))
+    {
 	SV *sv;
 	
 	PUSHMARK(MARK-1);
@@ -1869,7 +1878,7 @@ PP(pp_eof)
     else
 	gv = PL_last_in_gv = (GV*)POPs;		/* eof(FH) */
 
-    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	PUTBACK;
@@ -1895,7 +1904,7 @@ PP(pp_tell)
     else
 	gv = PL_last_in_gv = (GV*)POPs;
 
-    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	PUTBACK;
@@ -1933,7 +1942,7 @@ PP(pp_sysseek)
 
     gv = PL_last_in_gv = (GV*)POPs;
 
-    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+    if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
 #if LSEEKSIZE > IVSIZE
@@ -2061,7 +2070,7 @@ PP(pp_ioctl)
 {
     dSP; dTARGET;
     SV *argsv = POPs;
-    unsigned int func = U_I(POPn);
+    unsigned int func = POPu;
     int optype = PL_op->op_type;
     char *s;
     IV retval;
@@ -2193,6 +2202,9 @@ PP(pp_socket)
 	RETPUSHUNDEF;
     }
 
+    if (IoIFP(io))
+	do_close(gv, FALSE);
+
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0)
@@ -2251,6 +2263,11 @@ PP(pp_sockpair)
 	RETPUSHUNDEF;
     }
 
+    if (IoIFP(io1))
+	do_close(gv1, FALSE);
+    if (IoIFP(io2))
+	do_close(gv2, FALSE);
+
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
 	RETPUSHUNDEF;
@@ -3283,7 +3300,7 @@ PP(pp_fttext)
 #else
 	else if (*s & 128) {
 #ifdef USE_LOCALE
-	    if ((PL_op->op_private & OPpLOCALE) && isALPHA_LC(*s))
+	    if (IN_LOCALE_RUNTIME && isALPHA_LC(*s))
 		continue;
 #endif
 	    /* utf8 characters don't count as odd */
@@ -3686,7 +3703,7 @@ PP(pp_readdir)
 {
     dSP;
 #if defined(Direntry_t) && defined(HAS_READDIR)
-#ifndef I_DIRENT
+#if !defined(I_DIRENT) && !defined(VMS)
     Direntry_t *readdir (DIR *);
 #endif
     register Direntry_t *dp;
@@ -3889,7 +3906,13 @@ PP(pp_wait)
     Pid_t childpid;
     int argflags;
 
+#ifdef PERL_OLD_SIGNALS
     childpid = wait4pid(-1, &argflags, 0);
+#else
+    while ((childpid = wait4pid(-1, &argflags, 0)) == -1 && errno == EINTR) {
+	PERL_ASYNC_CHECK();
+    }
+#endif
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
     STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
@@ -3913,7 +3936,13 @@ PP(pp_waitpid)
 
     optype = POPi;
     childpid = TOPi;
+#ifdef PERL_OLD_SIGNALS
     childpid = wait4pid(childpid, &argflags, optype);
+#else
+    while ((childpid = wait4pid(childpid, &argflags, optype)) == -1 && errno == EINTR) {
+	PERL_ASYNC_CHECK();
+    }
+#endif
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
     STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
@@ -3941,7 +3970,7 @@ PP(pp_system)
 
     if (SP - MARK == 1) {
 	if (PL_tainting) {
-	    char *junk = SvPV(TOPs, n_a);
+	    (void)SvPV_nolen(TOPs);      /* stringify for taint check */
 	    TAINT_ENV();
 	    TAINT_PROPER("system");
 	}
@@ -4067,7 +4096,7 @@ PP(pp_exec)
 #endif
     else {
 	if (PL_tainting) {
-	    char *junk = SvPV(*SP, n_a);
+	    (void)SvPV_nolen(*SP);      /* stringify for taint check */
 	    TAINT_ENV();
 	    TAINT_PROPER("exec");
 	}
@@ -4622,14 +4651,14 @@ PP(pp_gnetent)
 
     if (which == OP_GNBYNAME)
 #ifdef HAS_GETNETBYNAME
-	nent = PerlSock_getnetbyname(POPpx);
+	nent = PerlSock_getnetbyname(POPpbytex);
 #else
         DIE(aTHX_ PL_no_sock_func, "getnetbyname");
 #endif
     else if (which == OP_GNBYADDR) {
 #ifdef HAS_GETNETBYADDR
 	int addrtype = POPi;
-	Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
+	Netdb_net_t addr = (Netdb_net_t) (U32)POPu;
 	nent = PerlSock_getnetbyaddr(addr, addrtype);
 #else
 	DIE(aTHX_ PL_no_sock_func, "getnetbyaddr");
@@ -4710,7 +4739,7 @@ PP(pp_gprotoent)
 
     if (which == OP_GPBYNAME)
 #ifdef HAS_GETPROTOBYNAME
-	pent = PerlSock_getprotobyname(POPpx);
+	pent = PerlSock_getprotobyname(POPpbytex);
 #else
 	DIE(aTHX_ PL_no_sock_func, "getprotobyname");
 #endif
@@ -4793,8 +4822,8 @@ PP(pp_gservent)
 
     if (which == OP_GSBYNAME) {
 #ifdef HAS_GETSERVBYNAME
-	char *proto = POPpx;
-	char *name = POPpx;
+	char *proto = POPpbytex;
+	char *name = POPpbytex;
 
 	if (proto && !*proto)
 	    proto = Nullch;
@@ -4806,7 +4835,7 @@ PP(pp_gservent)
     }
     else if (which == OP_GSBYPORT) {
 #ifdef HAS_GETSERVBYPORT
-	char *proto = POPpx;
+	char *proto = POPpbytex;
 	unsigned short port = POPu;
 
 #ifdef HAS_HTONS
@@ -5040,7 +5069,7 @@ PP(pp_gpwent)
 
     switch (which) {
     case OP_GPWNAM:
-	pwent  = getpwnam(POPpx);
+	pwent  = getpwnam(POPpbytex);
 	break;
     case OP_GPWUID:
 	pwent = getpwuid((Uid_t)POPi);
@@ -5241,7 +5270,7 @@ PP(pp_ggrent)
     STRLEN n_a;
 
     if (which == OP_GGRNAM)
-	grent = (struct group *)getgrnam(POPpx);
+	grent = (struct group *)getgrnam(POPpbytex);
     else if (which == OP_GGRGID)
 	grent = (struct group *)getgrgid(POPi);
     else