Change 19064 by [EMAIL PROTECTED] on 2003/03/26 19:48:32
Subject: [PATCH] Re: [perl #21542] local $_ [0] = $_ [0] fails.
From: Dave Mitchell <[EMAIL PROTECTED]>
Date: Thu, 20 Mar 2003 01:26:19 +0000
Message-ID: <[EMAIL PROTECTED]>
Subject: Re: [PATCH] Re: [perl #21542] local $_ [0] = $_ [0] fails.
From: Dave Mitchell <[EMAIL PROTECTED]>
Date: Mon, 24 Mar 2003 16:06:51 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/pp_ctl.c#350 edit
... //depot/perl/pp_hot.c#309 edit
... //depot/perl/scope.c#108 edit
... //depot/perl/t/op/args.t#3 edit
Differences ...
==== //depot/perl/pp_ctl.c#350 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#349~19025~ Tue Mar 18 13:59:33 2003
+++ perl/pp_ctl.c Wed Mar 26 11:48:32 2003
@@ -1949,6 +1949,7 @@
}
PL_stack_sp = newsp;
+ LEAVE;
/* Stack values are safe: */
if (popsub2) {
POPSUB(cx,sv); /* release CV and @_ ... */
@@ -1957,7 +1958,6 @@
sv = Nullsv;
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVE;
LEAVESUB(sv);
if (clear_errsv)
sv_setpv(ERRSV,"");
@@ -2033,6 +2033,7 @@
SP = newsp;
PUTBACK;
+ LEAVE;
/* Stack values are safe: */
switch (pop2) {
case CXt_LOOP:
@@ -2045,7 +2046,6 @@
}
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVE;
LEAVESUB(sv);
return nextop;
}
==== //depot/perl/pp_hot.c#309 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#308~19039~ Thu Mar 20 14:40:38 2003
+++ perl/pp_hot.c Wed Mar 26 11:48:32 2003
@@ -2320,10 +2320,10 @@
}
PUTBACK;
+ LEAVE;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVE;
LEAVESUB(sv);
return pop_return();
}
@@ -2376,9 +2376,9 @@
* the refcounts so the caller gets a live guy. Cannot set
* TEMP, so sv_2mortal is out of question. */
if (!CvLVALUE(cx->blk_sub.cv)) {
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "Can't modify non-lvalue subroutine call");
}
@@ -2387,9 +2387,9 @@
EXTEND_MORTAL(1);
if (MARK == SP) {
if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "Can't return %s from lvalue subroutine",
SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
@@ -2402,9 +2402,9 @@
}
}
else { /* Should not happen? */
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "%s returned from lvalue subroutine in scalar context",
(MARK > SP ? "Empty array" : "Array"));
@@ -2418,9 +2418,9 @@
&& SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
/* Might be flattened array after $#array = */
PUTBACK;
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "Can't return a %s from lvalue subroutine",
SvREADONLY(TOPs) ? "readonly value" : "temporary");
@@ -2472,10 +2472,10 @@
}
PUTBACK;
+ LEAVE;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVE;
LEAVESUB(sv);
return pop_return();
}
==== //depot/perl/scope.c#108 (text) ====
Index: perl/scope.c
--- perl/scope.c#107~18801~ Sun Mar 2 07:24:22 2003
+++ perl/scope.c Wed Mar 26 11:48:32 2003
@@ -604,6 +604,9 @@
SSPUSHINT(idx);
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_AELEM);
+ /* if it gets reified later, the restore will have the wrong refcnt */
+ if (!AvREAL(av) && AvREIFY(av))
+ SvREFCNT_inc(*sptr);
save_scalar_at(sptr);
sv = *sptr;
/* If we're localizing a tied array element, this new sv
@@ -686,7 +689,7 @@
value = (SV*)SSPOPPTR;
gv = (GV*)SSPOPPTR;
ptr = &GvSV(gv);
- SvREFCNT_dec(gv);
+ av = (AV*)gv; /* what to refcnt_dec */
goto restore_sv;
case SAVEt_GENERIC_PVREF: /* generic pv */
str = (char*)SSPOPPTR;
@@ -719,6 +722,7 @@
case SAVEt_SVREF: /* scalar reference */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
+ av = Nullav; /* what to refcnt_dec */
restore_sv:
sv = *(SV**)ptr;
DEBUG_S(PerlIO_printf(Perl_debug_log,
@@ -754,6 +758,8 @@
SvSETMAGIC(value);
PL_localizing = 0;
SvREFCNT_dec(value);
+ if (av) /* actually an av, hv or gv */
+ SvREFCNT_dec(av);
break;
case SAVEt_AV: /* array reference */
av = (AV*)SSPOPPTR;
@@ -963,13 +969,14 @@
value = (SV*)SSPOPPTR;
i = SSPOPINT;
av = (AV*)SSPOPPTR;
+ if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */
+ SvREFCNT_dec(value);
ptr = av_fetch(av,i,1);
if (ptr) {
sv = *(SV**)ptr;
if (sv && sv != &PL_sv_undef) {
if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
(void)SvREFCNT_inc(sv);
- SvREFCNT_dec(av);
goto restore_sv;
}
}
@@ -987,8 +994,8 @@
ptr = &HeVAL((HE*)ptr);
if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
(void)SvREFCNT_inc(*(SV**)ptr);
- SvREFCNT_dec(hv);
SvREFCNT_dec(sv);
+ av = (AV*)hv; /* what to refcnt_dec */
goto restore_sv;
}
}
==== //depot/perl/t/op/args.t#3 (xtext) ====
Index: perl/t/op/args.t
--- perl/t/op/args.t#2~6291~ Thu Jun 29 21:37:33 2000
+++ perl/t/op/args.t Wed Mar 26 11:48:32 2003
@@ -1,6 +1,6 @@
#!./perl
-print "1..9\n";
+print "1..11\n";
# test various operations on @_
@@ -72,4 +72,17 @@
for (1..5) { try() }
++$ord;
+print "ok $ord\n";
+
+# bug #21542 local $_[0] causes reify problems and coredumps
+
+sub local1 { local $_[0] }
+my $foo = 'foo'; local1($foo); local1($foo);
+print "got [$foo], expected [foo]\nnot " if $foo ne 'foo';
+$ord++;
+print "ok $ord\n";
+
+sub local2 { local $_[0]; last L }
+L: { local2 }
+$ord++;
print "ok $ord\n";
End of Patch.
