From: Bo Lindbergh <blgl@hagernas.com>
Date: Thu, 4 Jan 2007 18:22:09 +0000 (+0100)
Subject: Re: [PATCH] perlio.c repair
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a951d81d1408c83245c2beba7e057583534f618e;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] perlio.c repair
Message-Id: <E22DC961-6821-4AC2-BA2F-9B5B06927758@hagernas.com>

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

diff --git a/perlio.c b/perlio.c
index ed81598..ce20542 100644
--- a/perlio.c
+++ b/perlio.c
@@ -645,9 +645,13 @@ PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param)
 	int i;
 	list = PerlIO_list_alloc(aTHX);
 	for (i=0; i < proto->cur; i++) {
-	    SV *arg = NULL;
-	    if (proto->array[i].arg)
-		arg = PerlIO_sv_dup(aTHX_ proto->array[i].arg,param);
+	    SV *arg = proto->array[i].arg;
+#ifdef sv_dup
+	    if (arg && param)
+		arg = sv_dup(arg, param);
+#else
+	    PERL_UNUSED_ARG(param);
+#endif
 	    PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg);
 	}
     }
@@ -1015,10 +1019,13 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		    PerlIO_funcs * const layer =
 			PerlIO_find_layer(aTHX_ s, llen, 1);
 		    if (layer) {
+			SV *arg = NULL;
+			if (as)
+			    arg = newSVpvn(as, alen);
 			PerlIO_list_push(aTHX_ av, layer,
-					 (as) ? newSVpvn(as,
-							 alen) :
-					 &PL_sv_undef);
+					 (arg) ? arg : &PL_sv_undef);
+			if (arg)
+			    SvREFCNT_dec(arg);
 		    }
 		    else {
 			if (ckWARN(WARN_LAYER))
@@ -1493,12 +1500,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
     if (layers && *layers) {
 	PerlIO_list_t *av;
 	if (incdef) {
-	    IV i;
-	    av = PerlIO_list_alloc(aTHX);
-	    for (i = 0; i < def->cur; i++) {
-		PerlIO_list_push(aTHX_ av, def->array[i].funcs,
-				 def->array[i].arg);
-	    }
+	    av = PerlIO_clone_list(aTHX_ def, NULL);
 	}
 	else {
 	    av = def;
@@ -1543,10 +1545,13 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    PerlIOl *l = *f;
 	    layera = PerlIO_list_alloc(aTHX);
 	    while (l) {
-		SV * const arg = (l->tab->Getarg)
-			? (*l->tab->Getarg) (aTHX_ &l, NULL, 0)
-			: &PL_sv_undef;
-		PerlIO_list_push(aTHX_ layera, l->tab, arg);
+		SV *arg = NULL;
+		if (l->tab->Getarg)
+		    arg = (*l->tab->Getarg) (aTHX_ &l, NULL, 0);
+		PerlIO_list_push(aTHX_ layera, l->tab,
+				 (arg) ? arg : &PL_sv_undef);
+		if (arg)
+		    SvREFCNT_dec(arg);
 		l = *PerlIONext(&l);
 	    }
 	}
@@ -2220,7 +2225,9 @@ PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
 	return NULL;
 #ifdef sv_dup
     if (param) {
-	return sv_dup(arg, param);
+	arg = sv_dup(arg, param);
+	SvREFCNT_inc_simple_void_NN(arg);
+	return arg;
     }
     else {
 	return newSVsv(arg);
@@ -2244,19 +2251,15 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
     }
     if (f) {
 	PerlIO_funcs * const self = PerlIOBase(o)->tab;
-	SV *arg;
+	SV *arg = NULL;
 	char buf[8];
 	PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
 		     self->name, (void*)f, (void*)o, (void*)param);
 	if (self->Getarg)
 	    arg = (*self->Getarg)(aTHX_ o, param, flags);
-	else {
-	    arg = NULL;
-	}
 	f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
-	if (arg) {
+	if (arg)
 	    SvREFCNT_dec(arg);
-	}
     }
     return f;
 }