X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=a111f1eaad7b4f8022a6e4617de19bccbb244a41;hb=51254d33a14eeacb273f244a97f13b86d9e56aa2;hp=d6055f255d0a88d4a2c7e90024c817b0764bc8fa;hpb=4608196e45589eea5792cff92b551109899ddb06;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index d6055f2..a111f1e 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -453,7 +453,7 @@ PP(pp_warn)
     if (!tmps || !len)
 	tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
 
-    Perl_warn(aTHX_ "%"SVf, tmpsv);
+    Perl_warn(aTHX_ "%"SVf, (void*)tmpsv);
     RETSETYES;
 }
 
@@ -517,7 +517,7 @@ PP(pp_die)
     if (!tmps || !len)
 	tmpsv = sv_2mortal(newSVpvs("Died"));
 
-    DIE(aTHX_ "%"SVf, tmpsv);
+    DIE(aTHX_ "%"SVf, (void*)tmpsv);
 }
 
 /* I/O. */
@@ -836,7 +836,7 @@ PP(pp_tie)
 	stash = gv_stashsv(*MARK, FALSE);
 	if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
 	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
-		 methname, *MARK);
+		 methname, (void*)*MARK);
 	}
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
@@ -934,9 +934,7 @@ PP(pp_dbmopen)
     GV *gv;
 
     HV * const hv = (HV*)POPs;
-    SV * const sv = sv_mortalcopy(&PL_sv_no);
-
-    sv_setpv(sv, "AnyDBM_File");
+    SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
     stash = gv_stashsv(sv, FALSE);
     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
 	PUTBACK;
@@ -1137,8 +1135,7 @@ PP(pp_sselect)
     if (GIMME == G_ARRAY && tbuf) {
 	value = (NV)(timebuf.tv_sec) +
 		(NV)(timebuf.tv_usec) / 1000000.0;
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setnv(sv, value);
+	PUSHs(sv_2mortal(newSVnv(value)));
     }
     RETURN;
 #else
@@ -1150,8 +1147,7 @@ void
 Perl_setdefout(pTHX_ GV *gv)
 {
     dVAR;
-    if (gv)
-	(void)SvREFCNT_inc(gv);
+    SvREFCNT_inc_simple_void(gv);
     if (PL_defoutgv)
 	SvREFCNT_dec(PL_defoutgv);
     PL_defoutgv = gv;
@@ -1281,16 +1277,17 @@ PP(pp_enterwrite)
     else
 	fgv = gv;
 
+    if (!fgv) {
+	DIE(aTHX_ "Not a format reference");
+    }
     cv = GvFORM(fgv);
     if (!cv) {
-	if (fgv) {
-	    SV * const tmpsv = sv_newmortal();
-	    const char *name;
-	    gv_efullname4(tmpsv, fgv, NULL, FALSE);
-	    name = SvPV_nolen_const(tmpsv);
-	    if (name && *name)
-		DIE(aTHX_ "Undefined format \"%s\" called", name);
-	}
+	SV * const tmpsv = sv_newmortal();
+	const char *name;
+	gv_efullname4(tmpsv, fgv, NULL, FALSE);
+	name = SvPV_nolen_const(tmpsv);
+	if (name && *name)
+	    DIE(aTHX_ "Undefined format \"%s\" called", name);
 	DIE(aTHX_ "Not a format reference");
     }
     if (CvCLONE(cv))
@@ -1305,16 +1302,18 @@ PP(pp_leavewrite)
     dVAR; dSP;
     GV * const gv = cxstack[cxstack_ix].blk_sub.gv;
     register IO * const io = GvIOp(gv);
-    PerlIO * const ofp = IoOFP(io);
+    PerlIO *ofp;
     PerlIO *fp;
     SV **newsp;
     I32 gimme;
     register PERL_CONTEXT *cx;
 
+    if (!io || !(ofp = IoOFP(io)))
+        goto forget_top;
+
     DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
 	  (long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget)));
-    if (!io || !ofp)
-	goto forget_top;
+
     if (IoLINES_LEFT(io) < FmLINES(PL_formtarget) &&
 	PL_formtarget != PL_toptarget)
     {
@@ -1378,15 +1377,13 @@ PP(pp_leavewrite)
 	    gv_efullname4(sv, fgv, NULL, FALSE);
 	    name = SvPV_nolen_const(sv);
 	    if (name && *name)
-		DIE(aTHX_ "Undefined top format \"%s\" called",name);
+		DIE(aTHX_ "Undefined top format \"%s\" called", name);
+	    else
+		DIE(aTHX_ "Undefined top format called");
 	}
-	/* why no:
-	else
-	    DIE(aTHX_ "Undefined top format called");
-	?*/
-	if (CvCLONE(cv))
+	if (cv && CvCLONE(cv))
 	    cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
-	return doform(cv,gv,PL_op);
+	return doform(cv, gv, PL_op);
     }
 
   forget_top:
@@ -1780,11 +1777,13 @@ PP(pp_send)
     IO *io;
     SV *bufsv;
     const char *buffer;
-    Size_t length = 0;
     SSize_t retval;
     STRLEN blen;
+    STRLEN orig_blen_bytes;
     MAGIC *mg;
     const int op_type = PL_op->op_type;
+    bool doing_utf8;
+    U8 *tmpbuf = NULL;
     
     GV *const gv = (GV*)*++MARK;
     if (PL_op->op_type == OP_SYSWRITE
@@ -1816,19 +1815,6 @@ PP(pp_send)
 
     bufsv = *++MARK;
 
-    if (op_type == OP_SYSWRITE) {
-	if (MARK >= SP) {
-	    length = (Size_t) sv_len(bufsv);
-	} else {
-#if Size_t_size > IVSIZE
-	    length = (Size_t)SvNVx(*++MARK);
-#else
-	    length = (Size_t)SvIVx(*++MARK);
-#endif
-	    if ((SSize_t)length < 0)
-		DIE(aTHX_ "Negative length");
-	}
-    }
     SETERRNO(0,0);
     io = GvIO(gv);
     if (!io || !IoIFP(io)) {
@@ -1839,43 +1825,111 @@ PP(pp_send)
 	goto say_undef;
     }
 
+    /* Do this first to trigger any overloading.  */
+    buffer = SvPV_const(bufsv, blen);
+    orig_blen_bytes = blen;
+    doing_utf8 = DO_UTF8(bufsv);
+
     if (PerlIO_isutf8(IoIFP(io))) {
 	if (!SvUTF8(bufsv)) {
-	    bufsv = sv_2mortal(newSVsv(bufsv));
-	    buffer = sv_2pvutf8(bufsv, &blen);
-	} else
-	    buffer = SvPV_const(bufsv, blen);
+	    /* We don't modify the original scalar.  */
+	    tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
+	    buffer = (char *) tmpbuf;
+	    doing_utf8 = TRUE;
+	}
     }
-    else {
-	 if (DO_UTF8(bufsv)) {
-	      /* Not modifying source SV, so making a temporary copy. */
-	      bufsv = sv_2mortal(newSVsv(bufsv));
-	      sv_utf8_downgrade(bufsv, FALSE);
-	 }
-	 buffer = SvPV_const(bufsv, blen);
+    else if (doing_utf8) {
+	STRLEN tmplen = blen;
+	U8 *result = bytes_from_utf8((const U8*) buffer, &tmplen, &doing_utf8);
+	if (!doing_utf8) {
+	    tmpbuf = result;
+	    buffer = (char *) tmpbuf;
+	    blen = tmplen;
+	}
+	else {
+	    assert((char *)result == buffer);
+	    Perl_croak(aTHX_ "Wide character in %s", OP_DESC(PL_op));
+	}
     }
 
     if (op_type == OP_SYSWRITE) {
+	Size_t length = 0; /* This length is in characters.  */
+	STRLEN blen_chars;
 	IV offset;
-	if (DO_UTF8(bufsv)) {
-	    /* length and offset are in chars */
-	    blen   = sv_len_utf8(bufsv);
+
+	if (doing_utf8) {
+	    if (tmpbuf) {
+		/* The SV is bytes, and we've had to upgrade it.  */
+		blen_chars = orig_blen_bytes;
+	    } else {
+		/* The SV really is UTF-8.  */
+		if (SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
+		    /* Don't call sv_len_utf8 again because it will call magic
+		       or overloading a second time, and we might get back a
+		       different result.  */
+		    blen_chars = utf8_length((U8*)buffer, (U8*)buffer + blen);
+		} else {
+		    /* It's safe, and it may well be cached.  */
+		    blen_chars = sv_len_utf8(bufsv);
+		}
+	    }
+	} else {
+	    blen_chars = blen;
+	}
+
+	if (MARK >= SP) {
+	    length = blen_chars;
+	} else {
+#if Size_t_size > IVSIZE
+	    length = (Size_t)SvNVx(*++MARK);
+#else
+	    length = (Size_t)SvIVx(*++MARK);
+#endif
+	    if ((SSize_t)length < 0) {
+		Safefree(tmpbuf);
+		DIE(aTHX_ "Negative length");
+	    }
 	}
+
 	if (MARK < SP) {
 	    offset = SvIVx(*++MARK);
 	    if (offset < 0) {
-		if (-offset > (IV)blen)
+		if (-offset > (IV)blen_chars) {
+		    Safefree(tmpbuf);
 		    DIE(aTHX_ "Offset outside string");
-		offset += blen;
-	    } else if (offset >= (IV)blen && blen > 0)
+		}
+		offset += blen_chars;
+	    } else if (offset >= (IV)blen_chars && blen_chars > 0) {
+		Safefree(tmpbuf);
 		DIE(aTHX_ "Offset outside string");
+	    }
 	} else
 	    offset = 0;
-	if (length > blen - offset)
-	    length = blen - offset;
-	if (DO_UTF8(bufsv)) {
-	    buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
-	    length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
+	if (length > blen_chars - offset)
+	    length = blen_chars - offset;
+	if (doing_utf8) {
+	    /* Here we convert length from characters to bytes.  */
+	    if (tmpbuf || SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
+		/* Either we had to convert the SV, or the SV is magical, or
+		   the SV has overloading, in which case we can't or mustn't
+		   or mustn't call it again.  */
+
+		buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
+		length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
+	    } else {
+		/* It's a real UTF-8 SV, and it's not going to change under
+		   us.  Take advantage of any cache.  */
+		I32 start = offset;
+		I32 len_I32 = length;
+
+		/* Convert the start and end character positions to bytes.
+		   Remember that the second argument to sv_pos_u2b is relative
+		   to the first.  */
+		sv_pos_u2b(bufsv, &start, &len_I32);
+
+		buffer += start;
+		length = len_I32;
+	    }
 	}
 	else {
 	    buffer = buffer+offset;
@@ -1911,11 +1965,15 @@ PP(pp_send)
     else
 	DIE(aTHX_ PL_no_sock_func, "send");
 #endif
+
     if (retval < 0)
 	goto say_undef;
     SP = ORIGMARK;
-    if (DO_UTF8(bufsv))
+    if (doing_utf8)
         retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
+
+    if (tmpbuf)
+	Safefree(tmpbuf);
 #if Size_t_size > IVSIZE
     PUSHn(retval);
 #else
@@ -1924,6 +1982,8 @@ PP(pp_send)
     RETURN;
 
   say_undef:
+    if (tmpbuf)
+	Safefree(tmpbuf);
     SP = ORIGMARK;
     RETPUSHUNDEF;
 }
@@ -2280,7 +2340,7 @@ PP(pp_socket)
     if (!gv || !io) {
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
-	if (IoIFP(io))
+	if (io && IoIFP(io))
 	    do_close(gv, FALSE);
 	SETERRNO(EBADF,LIB_INVARG);
 	RETPUSHUNDEF;
@@ -2336,9 +2396,9 @@ PP(pp_sockpair)
 	    if (!gv2 || !io2)
 		report_evil_fh(gv1, io2, PL_op->op_type);
 	}
-	if (IoIFP(io1))
+	if (io1 && IoIFP(io1))
 	    do_close(gv1, FALSE);
-	if (IoIFP(io2))
+	if (io2 && IoIFP(io2))
 	    do_close(gv2, FALSE);
 	RETPUSHUNDEF;
     }
@@ -4016,7 +4076,8 @@ PP(pp_system)
 	    SP = ORIGMARK;
 	    if (did_pipes) {
 		int errkid;
-		int n = 0, n1;
+		unsigned n = 0;
+		SSize_t n1;
 
 		while (n < sizeof(int)) {
 		    n1 = PerlLIO_read(pp[0],
@@ -4494,6 +4555,27 @@ PP(pp_semctl)
 #endif
 }
 
+/* I can't const this further without getting warnings about the types of
+   various arrays passed in from structures.  */
+static SV *
+S_space_join_names_mortal(pTHX_ char *const *array)
+{
+    SV *target;
+
+    if (array && *array) {
+	target = sv_2mortal(newSVpvs(""));
+	while (1) {
+	    sv_catpv(target, *array);
+	    if (!*++array)
+		break;
+	    sv_catpvs(target, " ");
+	}
+    } else {
+	target = sv_mortalcopy(&PL_sv_no);
+    }
+    return target;
+}
+
 /* Get system info. */
 
 PP(pp_ghostent)
@@ -4564,28 +4646,20 @@ PP(pp_ghostent)
     }
 
     if (hent) {
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, (char*)hent->h_name);
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	for (elem = hent->h_aliases; elem && *elem; elem++) {
-	    sv_catpv(sv, *elem);
-	    if (elem[1])
-		sv_catpvs(sv, " ");
-	}
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setiv(sv, (IV)hent->h_addrtype);
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+	PUSHs(sv_2mortal(newSVpv((char*)hent->h_name, 0)));
+	PUSHs(space_join_names_mortal(hent->h_aliases));
+	PUSHs(sv_2mortal(newSViv((IV)hent->h_addrtype)));
 	len = hent->h_length;
-	sv_setiv(sv, (IV)len);
+	PUSHs(sv_2mortal(newSViv((IV)len)));
 #ifdef h_addr
 	for (elem = hent->h_addr_list; elem && *elem; elem++) {
-	    XPUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	    sv_setpvn(sv, *elem, len);
+	    XPUSHs(sv_2mortal(newSVpvn(*elem, len)));
 	}
 #else
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	if (hent->h_addr)
-	    sv_setpvn(sv, hent->h_addr, len);
+	    PUSHs(newSVpvn(hent->h_addr, len));
+	else
+	    PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif /* h_addr */
     }
     RETURN;
@@ -4599,7 +4673,6 @@ PP(pp_gnetent)
 #if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
     dVAR; dSP;
     I32 which = PL_op->op_type;
-    register char **elem;
     register SV *sv;
 #ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
     struct netent *getnetbyaddr(Netdb_net_t, int);
@@ -4656,18 +4729,10 @@ PP(pp_gnetent)
     }
 
     if (nent) {
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, nent->n_name);
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	for (elem = nent->n_aliases; elem && *elem; elem++) {
-	    sv_catpv(sv, *elem);
-	    if (elem[1])
-		sv_catpvs(sv, " ");
-	}
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setiv(sv, (IV)nent->n_addrtype);
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setiv(sv, (IV)nent->n_net);
+	PUSHs(sv_2mortal(newSVpv(nent->n_name, 0)));
+	PUSHs(space_join_names_mortal(nent->n_aliases));
+	PUSHs(sv_2mortal(newSViv((IV)nent->n_addrtype)));
+	PUSHs(sv_2mortal(newSViv((IV)nent->n_net)));
     }
 
     RETURN;
@@ -4681,7 +4746,6 @@ PP(pp_gprotoent)
 #if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
     dVAR; dSP;
     I32 which = PL_op->op_type;
-    register char **elem;
     register SV *sv;
 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
     struct protoent *getprotobyname(Netdb_name_t);
@@ -4726,16 +4790,9 @@ PP(pp_gprotoent)
     }
 
     if (pent) {
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, pent->p_name);
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	for (elem = pent->p_aliases; elem && *elem; elem++) {
-	    sv_catpv(sv, *elem);
-	    if (elem[1])
-		sv_catpvs(sv, " ");
-	}
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setiv(sv, (IV)pent->p_proto);
+	PUSHs(sv_2mortal(newSVpv(pent->p_name, 0)));
+	PUSHs(space_join_names_mortal(pent->p_aliases));
+	PUSHs(sv_2mortal(newSViv((IV)pent->p_proto)));
     }
 
     RETURN;
@@ -4749,7 +4806,6 @@ PP(pp_gservent)
 #if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
     dVAR; dSP;
     I32 which = PL_op->op_type;
-    register char **elem;
     register SV *sv;
 #ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
     struct servent *getservbyname(Netdb_name_t, Netdb_name_t);
@@ -4804,22 +4860,14 @@ PP(pp_gservent)
     }
 
     if (sent) {
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, sent->s_name);
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	for (elem = sent->s_aliases; elem && *elem; elem++) {
-	    sv_catpv(sv, *elem);
-	    if (elem[1])
-		sv_catpvs(sv, " ");
-	}
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+	PUSHs(sv_2mortal(newSVpv(sent->s_name, 0)));
+	PUSHs(space_join_names_mortal(sent->s_aliases));
 #ifdef HAS_NTOHS
-	sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
+	PUSHs(sv_2mortal(newSViv((IV)PerlSock_ntohs(sent->s_port))));
 #else
-	sv_setiv(sv, (IV)(sent->s_port));
+	PUSHs(sv_2mortal(newSViv((IV)(sent->s_port))));
 #endif
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, sent->s_proto);
+	PUSHs(sv_2mortal(newSVpv(sent->s_proto, 0)));
     }
 
     RETURN;
@@ -5035,11 +5083,9 @@ PP(pp_gpwent)
     }
 
     if (pwent) {
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, pwent->pw_name);
+	PUSHs(sv_2mortal(newSVpv(pwent->pw_name, 0)));
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	SvPOK_off(sv);
+	PUSHs(sv = sv_2mortal(newSViv(0)));
 	/* If we have getspnam(), we try to dig up the shadow
 	 * password.  If we are underprivileged, the shadow
 	 * interface will set the errno to EACCES or similar,
@@ -5082,70 +5128,70 @@ PP(pp_gpwent)
 	SvTAINTED_on(sv);
 #   endif
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   if Uid_t_sign <= 0
-	sv_setiv(sv, (IV)pwent->pw_uid);
+	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_uid)));
 #   else
-	sv_setuv(sv, (UV)pwent->pw_uid);
+	PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_uid)));
 #   endif
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   if Uid_t_sign <= 0
-	sv_setiv(sv, (IV)pwent->pw_gid);
+	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_gid)));
 #   else
-	sv_setuv(sv, (UV)pwent->pw_gid);
+	PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_gid)));
 #   endif
 	/* pw_change, pw_quota, and pw_age are mutually exclusive--
 	 * because of the poor interface of the Perl getpw*(),
 	 * not because there's some standard/convention saying so.
 	 * A better interface would have been to return a hash,
 	 * but we are accursed by our history, alas. --jhi.  */
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   ifdef PWCHANGE
-	sv_setiv(sv, (IV)pwent->pw_change);
+	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_change)));
 #   else
 #       ifdef PWQUOTA
-	sv_setiv(sv, (IV)pwent->pw_quota);
+	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_quota)));
 #       else
 #           ifdef PWAGE
-	sv_setpv(sv, pwent->pw_age);
+	PUSHs(sv_2mortal(newSVpv(pwent->pw_age, 0)));
+#	    else
+	/* I think that you can never get this compiled, but just in case.  */
+	PUSHs(sv_mortalcopy(&PL_sv_no));
 #           endif
 #       endif
 #   endif
 
 	/* pw_class and pw_comment are mutually exclusive--.
 	 * see the above note for pw_change, pw_quota, and pw_age. */
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   ifdef PWCLASS
-	sv_setpv(sv, pwent->pw_class);
+	PUSHs(sv_2mortal(newSVpv(pwent->pw_class, 0)));
 #   else
 #       ifdef PWCOMMENT
-	sv_setpv(sv, pwent->pw_comment);
+	PUSHs(sv_2mortal(newSVpv(pwent->pw_comment, 0)));
+#	else
+	/* I think that you can never get this compiled, but just in case.  */
+	PUSHs(sv_mortalcopy(&PL_sv_no));
 #       endif
 #   endif
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   ifdef PWGECOS
-	sv_setpv(sv, pwent->pw_gecos);
+	PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0)));
+#   else
+	PUSHs(sv_mortalcopy(&PL_sv_no));
 #   endif
 #   ifndef INCOMPLETE_TAINTS
 	/* pw_gecos is tainted because user himself can diddle with it. */
 	SvTAINTED_on(sv);
 #   endif
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, pwent->pw_dir);
+	PUSHs(sv_2mortal(newSVpv(pwent->pw_dir, 0)));
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, pwent->pw_shell);
+	PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));
 #   ifndef INCOMPLETE_TAINTS
 	/* pw_shell is tainted because user himself can diddle with it. */
 	SvTAINTED_on(sv);
 #   endif
 
 #   ifdef PWEXPIRE
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setiv(sv, (IV)pwent->pw_expire);
+	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_expire)));
 #   endif
     }
     RETURN;
@@ -5213,21 +5259,17 @@ PP(pp_ggrent)
     }
 
     if (grent) {
-	SV *sv;
-	char **elem;
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setpv(sv, grent->gr_name);
+	PUSHs(sv_2mortal(newSVpv(grent->gr_name, 0)));
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #ifdef GRPASSWD
-	sv_setpv(sv, grent->gr_passwd);
+	PUSHs(sv_2mortal(newSVpv(grent->gr_passwd, 0)));
+#else
+	PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif
 
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-	sv_setiv(sv, (IV)grent->gr_gid);
+	PUSHs(sv_2mortal(newSViv((IV)grent->gr_gid)));
 
 #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
-	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	/* In UNICOS/mk (_CRAYMPP) the multithreading
 	 * versions (getgrnam_r, getgrgid_r)
 	 * seem to return an illegal pointer
@@ -5236,11 +5278,7 @@ PP(pp_ggrent)
 	 * but the gr_mem is poisonous anyway.
 	 * So yes, you cannot get the list of group
 	 * members if building multithreaded in UNICOS/mk. */
-	for (elem = grent->gr_mem; elem && *elem; elem++) {
-	    sv_catpv(sv, *elem);
-	    if (elem[1])
-		sv_catpvs(sv, " ");
-	}
+	PUSHs(space_join_names_mortal(grent->gr_mem));
 #endif
     }