From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 2 Feb 2008 11:05:17 +0000 (+0000)
Subject: In XS_PerlIO_get_layers() take advantage of the implementation of
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92e45a3e6a37177cdf8021650cda6bd5a43fdbdf;p=p5sagit%2Fp5-mst-13.2.git

In XS_PerlIO_get_layers() take advantage of the implementation of
PerlIO_get_layers(), by co-opting the new SVs it creates, rather than
copying them.

p4raw-id: //depot/perl@33182
---

diff --git a/perlio.c b/perlio.c
index 76fe225..3cb591d 100644
--- a/perlio.c
+++ b/perlio.c
@@ -759,6 +759,11 @@ PerlIO_get_layers(pTHX_ PerlIO *f)
 	PerlIOl *l = PerlIOBase(f);
 
 	while (l) {
+	    /* There is some collusion in the implementation of
+	       XS_PerlIO_get_layers - it knows that name and flags are
+	       generated as fresh SVs here, and takes advantage of that to
+	       "copy" them by taking a reference. If it changes here, it needs
+	       to change there too.  */
 	    SV * const name = l->tab && l->tab->name ?
 	    newSVpv(l->tab->name, 0) : &PL_sv_undef;
 	    SV * const arg = l->tab && l->tab->Getarg ?
diff --git a/universal.c b/universal.c
index 6860cec..ce73c82 100644
--- a/universal.c
+++ b/universal.c
@@ -969,16 +969,22 @@ XS(XS_PerlIO_get_layers)
 		  const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
 
 		  if (details) {
+		      /* Indents of 5? Yuck.  */
+		      /* We know that PerlIO_get_layers creates a new SV for
+			 the name and flags, so we can just take a reference
+			 and "steal" it when we free the AV below.  */
 		       XPUSHs(namok
-			      ? sv_2mortal(newSVpvn(SvPVX_const(*namsvp), SvCUR(*namsvp)))
+			      ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))
 			      : &PL_sv_undef);
 		       XPUSHs(argok
-			      ? sv_2mortal(newSVpvn(SvPVX_const(*argsvp), SvCUR(*argsvp)))
+			      ? newSVpvn_flags(SvPVX_const(*argsvp),
+					       SvCUR(*argsvp),
+					       (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
+					       | SVs_TEMP)
+			      : &PL_sv_undef);
+		       XPUSHs(namok
+			      ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
 			      : &PL_sv_undef);
-		       if (flgok)
-			    mXPUSHi(SvIVX(*flgsvp));
-		       else
-			    XPUSHs(&PL_sv_undef);
 		       nitem += 3;
 		  }
 		  else {
@@ -987,8 +993,7 @@ XS(XS_PerlIO_get_layers)
 						 SVfARG(*namsvp),
 						 SVfARG(*argsvp))));
 		       else if (namok)
-			    XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf,
-						 SVfARG(*namsvp))));
+			   XPUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)));
 		       else
 			    XPUSHs(&PL_sv_undef);
 		       nitem++;