Change 30181 by nicholas@nicholas-saigo on 2007/02/09 17:20:56
Reverse change 29132, which was the integration of change 25808:
Subject: Re: [PATCH] Re: [perl #37350] $#{@$aref} in debugger gives: Bizarre copy of ARRAY in leave
From: Robin Houston <robin (AT) cpan (DOT) org>
Date: 14, 2005 1:54 AM
Message-ID: <20051013235457.GA23386 (AT) rpc142 (DOT) cs.man.ac.uk>
because it's likely that too much code out there relies on this bug.
Affected files
//depot/maint-5.8/perl/embed.fnc#205 edit
//depot/maint-5.8/perl/embed.h#153 edit
//#59 edit
//depot/maint-5.8/perl/mathoms.c#28 edit
//depot/maint-5.8/perl/op.c#196 edit
//depot/maint-5.8/perl/op.h#34 edit
//depot/maint-5.8/perl/proto.h#197 edit
//#10 edit
Differences
//depot/maint-5.8/perl/embed.fnc#205 (text)
Index: perl/embed.fnc
perl/embed.fnc#204~30099~2007-02-02 13:14:53.000000000 -0800
perl/embed.fnc2007-02-09 09:20:56.000000000 -0800
@@ -621,7 +621,6 @@
Apd|I32|call_pv|NN const char* sub_name|I32 flags
Apd|I32|call_sv|NN SV* sv|I32 flags
Ap|void|despatch_signals
-Ap|P *|doref|NN P *o|I32 type|bool set_op_ref
Apd|SV*|eval_pv|NN const char* p|I32 croak_on_error
Apd|I32|eval_sv|NN SV* sv|I32 flags
Apd|SV*|get_sv|NN const char* name|I32 create
@@ -649,7 +648,7 @@
p|P*|prepend_elem|I32 optype|NULLK P* head|NULLK P* tail
p|void|push_return|NULLK P* o
Ap|void|push_scope
-Amb|P*|ref|NULLK P* o|I32 type
+p|P*|ref|NULLK P* o|I32 type
p|P*|refkids|NULLK P* o|I32 type
Ap|void|regdump|NN const regexp* r
Ap|SV*|regclass_swash|NN struct regnode *n|bool doinit|NULLK SV **listsvp|NULLK SV **altsvp
//depot/maint-5.8/perl/embed.h#153 (text+w)
Index: perl/embed.h
perl/embed.h#152~30075~2007-01-29 15:16:13.000000000 -0800
perl/embed.h2007-02-09 09:20:56.000000000 -0800
@@ -641,7 +641,6 @@
#define call_pvPerl_call_pv
#define call_svPerl_call_sv
#define despatch_signalsPerl_despatch_signals
-#define dorefPerl_doref
#define eval_pvPerl_eval_pv
#define eval_svPerl_eval_sv
#define get_svPerl_get_sv
@@ -675,6 +674,7 @@
#endif
#define push_scopePerl_push_scope
#ifdef PERL_CRE
+#define refPerl_ref
#define refkidsPerl_refkids
#endif
#define regdumpPerl_regdump
@@ -1686,6 +1686,11 @@
#ifdef PERL_CRE
#define my_swabnPerl_my_swabn
#endif
+#define gv_fetchpvn_flagsPerl_gv_fetchpvn_flags
+#define gv_fetchsvPerl_gv_fetchsv
+#ifdef PERL_CRE
+#define is_gv_magical_svPerl_is_gv_magical_sv
+#endif
#if defined(PERL_INP_C) || defined(PERL_DECL_PRT)
#define ck_anoncodePerl_ck_anoncode
#define ck_bitopPerl_ck_bitop
@@ -1748,11 +1753,6 @@
#endif
#ifndef HAS_STRLCPY
#endif
-#define gv_fetchpvn_flagsPerl_gv_fetchpvn_flags
-#define gv_fetchsvPerl_gv_fetchsv
-#ifdef PERL_CRE
-#define is_gv_magical_svPerl_is_gv_magical_sv
-#endif
#ifndef SPRINTF_RETURNS_STRLEN
#endif
#define ck_anoncodePerl_ck_anoncode
@@ -2740,7 +2740,6 @@
#define call_pv(a,b)Perl_call_pv(aTHX_ a,b)
#define call_sv(a,b)Perl_call_sv(aTHX_ a,b)
#define despatch_signals()Perl_despatch_signals(aTHX)
-#define doref(a,b,c)Perl_doref(aTHX_ a,b,c)
#define eval_pv(a,b)Perl_eval_pv(aTHX_ a,b)
#define eval_sv(a,b)Perl_eval_sv(aTHX_ a,b)
#define get_sv(a,b)Perl_get_sv(aTHX_ a,b)
@@ -2774,6 +2773,7 @@
#endif
#define push_scope()Perl_push_scope(aTHX)
#ifdef PERL_CRE
+#define ref(a,b)Perl_ref(aTHX_ a,b)
#define refkids(a,b)Perl_refkids(aTHX_ a,b)
#endif
#define regdump(a)Perl_regdump(aTHX_ a)
@@ -3780,6 +3780,11 @@
#ifdef PERL_CRE
#define my_swabnPerl_my_swabn
#endif
+#define gv_fetchpvn_flags(a,b,c,d)Perl_gv_fetchpvn_flags(aTHX_ a,b,c,d)
+#define gv_fetchsv(a,b,c)Perl_gv_fetchsv(aTHX_ a,b,c)
+#ifdef PERL_CRE
+#define is_gv_magical_sv(a,b)Perl_is_gv_magical_sv(aTHX_ a,b)
+#endif
#if defined(PERL_INP_C) || defined(PERL_DECL_PRT)
#define ck_anoncode(a)Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a)Perl_ck_bitop(aTHX_ a)
@@ -3842,11 +3847,6 @@
#endif
#ifndef HAS_STRLCPY
#endif
-#define gv_fetchpvn_flags(a,b,c,d)Perl_gv_fetchpvn_flags(aTHX_ a,b,c,d)
-#define gv_fetchsv(a,b,c)Perl_gv_fetchsv(aTHX_ a,b,c)
-#ifdef PERL_CRE
-#define is_gv_magical_sv(a,b)Perl_is_gv_magical_sv(aTHX_ a,b)
-#endif
#ifndef SPRINTF_RETURNS_STRLEN
#endif
#define ck_anoncode(a)Perl_ck_anoncode(aTHX_ a)
//#59 (text+w)
Index: perl/global.sym
perl/global.sym#58~30021~2007-01-26 11:23:54.000000000 -0800
perl/global.sym2007-02-09 09:20:56.000000000 -0800
@@ -350,7 +350,6 @@
Perl_call_pv
Perl_call_sv
Perl_despatch_signals
-Perl_doref
Perl_eval_pv
Perl_eval_sv
Perl_get_sv
@@ -371,7 +370,6 @@
Perl_pmflag
Perl_pop_scope
Perl_push_scope
-Perl_ref
Perl_regdump
Perl_regclass_swash
Perl_pregexec
//depot/maint-5.8/perl/mathoms.c#28 (text)
Index: perl/mathoms.c
perl/mathoms.c#27~30069~2007-01-29 13:05:26.000000000 -0800
perl/mathoms.c2007-02-09 09:20:56.000000000 -0800
@@ -67,6 +67,7 @@
PERL_CALLCNV int Perl_printf_nocontext(const char *format, );
+#if 0
/* ref() is now a macro using Perl_doref;
* this version provided for binary compatibility only.
*/
@@ -75,6 +76,7 @@
{
return doref(o, type, TRUE);
}
+#endif
/*
=for apidoc sv_unref
//depot/maint-5.8/perl/op.c#196 (text)
Index: perl/op.c
perl/op.c#195~30110~2007-02-03 11:00:21.000000000 -0800
perl/op.c2007-02-09 09:20:56.000000000 -0800
@@ -1450,7 +1450,7 @@
}
P *
-Perl_doref(pTHX_ P *o, I32 type, bool set_op_ref)
+Perl_ref(pTHX_ P *o, I32 type)
{
P *kid;
@@ -1472,12 +1472,12 @@
case P_CND_EXPR:
for (kid = cUNPo->op_first->op_sibling; kid; kid = kid->op_sibling)
- doref(kid, type, set_op_ref);
+ ref(kid, type);
break;
case P_RV2SV:
if (type == P_DEFINED)
o->op_flags |= Pf_SPECIAL;/* don't create GV */
-doref(cUNPo->op_first, o->op_type, set_op_ref);
+ref(cUNPo->op_first, o->op_type);
/* FALL THRUGH */
case P_PADSV:
if (type == P_RV2SV || type == P_RV2AV || type == P_RV2HV) {
@@ -1496,30 +1496,28 @@
case P_RV2AV:
case P_RV2HV:
-if (set_op_ref)
- o->op_flags |= Pf_REF;
+o->op_flags |= Pf_REF;
/* FALL THRUGH */
case P_RV2GV:
if (type == P_DEFINED)
o->op_flags |= Pf_SPECIAL;/* don't create GV */
-doref(cUNPo->op_first, o->op_type, set_op_ref);
+ref(cUNPo->op_first, o->op_type);
break;
case P_PADAV:
case P_PADHV:
-if (set_op_ref)
- o->op_flags |= Pf_REF;
+o->op_flags |= Pf_REF;
break;
case P_SCALAR:
case P_NULL:
if (!(o->op_flags & Pf_KIDS))
break;
-doref(cBINPo->op_first, type, set_op_ref);
+ref(cBINPo->op_first, type);
break;
case P_AELEM:
case P_HELEM:
-doref(cBINPo->op_first, o->op_type, set_op_ref);
+ref(cBINPo->op_first, o->op_type);
if (type == P_RV2SV || type == P_RV2AV || type == P_RV2HV) {
o->op_private |= (type == P_RV2AV ? PpDEREF_AV
: type == P_RV2HV ? PpDEREF_HV
@@ -1530,13 +1528,11 @@
case P_SCPE:
case P_LEAVE:
-set_op_ref = FALSE;
-/* FALL THRUGH */
case P_ENTER:
case P_LIST:
if (!(o->op_flags & Pf_KIDS))
break;
-doref(cLISTPo->op_last, type, set_op_ref);
+ref(cLISTPo->op_last, type);
break;
default:
break;
//depot/maint-5.8/perl/op.h#34 (text)
Index: perl/op.h
perl/op.h#33~30071~2007-01-29 14:30:00.000000000 -0800
perl/op.h2007-02-09 09:20:56.000000000 -0800
@@ -518,10 +518,6 @@
#define PERL_LADMD_NIMPRT0x2
#define PERL_LADMD_IMPRTPS0x4
-#if defined(PERL_IN_PERLY_C) || defined(PERL_INP_C)
-#define ref(o, type) doref(o, type, TRUE)
-#endif
-
/* no longer used anywhere in core */
#ifndef PERL_CRE
#define cv_ckproto(cv, gv, p) \
//depot/maint-5.8/perl/proto.h#197 (text+w)
Index: perl/proto.h
perl/proto.h#196~30180~2007-02-09 08:04:07.000000000 -0800
perl/proto.h2007-02-09 09:20:56.000000000 -0800
@@ -1020,7 +1020,6 @@
PERL_CALLCNV I32Perl_call_pv(pTHX_ const char* sub_name, I32 flags);
PERL_CALLCNV I32Perl_call_sv(pTHX_ SV* sv, I32 flags);
PERL_CALLCNV voidPerl_despatch_signals(pTHX);
-PERL_CALLCNV P *Perl_doref(pTHX_ P *o, I32 type, bool set_op_ref);
PERL_CALLCNV SV*Perl_eval_pv(pTHX_ const char* p, I32 croak_on_error);
PERL_CALLCNV I32Perl_eval_sv(pTHX_ SV* sv, I32 flags);
PERL_CALLCNV SV*Perl_get_sv(pTHX_ const char* name, I32 create);
@@ -1047,7 +1046,7 @@
PERL_CALLCNV P*Perl_prepend_elem(pTHX_ I32 optype, P* head, P* tail);
PERL_CALLCNV voidPerl_push_return(pTHX_ P* o);
PERL_CALLCNV voidPerl_push_scope(pTHX);
-/* PERL_CALLCNV P*ref(pTHX_ P* o, I32 type); */
+PERL_CALLCNV P*Perl_ref(pTHX_ P* o, I32 type);
PERL_CALLCNV P*Perl_refkids(pTHX_ P* o, I32 type);
PERL_CALLCNV voidPerl_regdump(pTHX_ const regexp* r);
PERL_CALLCNV SV*Perl_regclass_swash(pTHX_ struct regnode *n, bool doinit, SV **listsvp, SV **altsvp);
//#10 (xtext)
Index: perl/t/op/array.t
perl/t/op/array.t#9~30048~2007-01-27 16:08:17.000000000 -0800
perl/t/op/array.t2007-02-09 09:20:56.000000000 -0800
@@ -7,7 +7,7 @@
require 'test.pl';
-plan (105);
+plan (99);
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -318,36 +318,6 @@
}
{
- # Bug #37350
- my @array = (14);
- $#{@array} = 7;
- is ($#{4}, 7);
-
- my $x;
- $#{$x} = 3;
- is(scalar @$x, 4);
-
- push @{@array}, 23;
- is ($4[8], 23);
-}
-{
- # Bug #37350 -- once more with a global
- use vars '@array';
- @array = (14);
- $#{@array} = 7;
- is ($#{4}, 7);
-
- my $x;
- $#{$x} = 3;
- is(scalar @$x, 4);
-
- push @{@array}, 23;
- is ($4[8], 23);
-}
-
-# more tests for AASSIGN_CMMN
-
-{
our($x,$y,$z) = (13);
our($y,$z) = ($x,$y);
is("$x $y $z", "1 1 2");
End of Patch.