Change 30181 by [EMAIL PROTECTED] on 2007/02/09 17:20:56
Reverse change 29132, which was the integration of change 25808:
Subject: Re: [PATCH] Re: [perl #37350] [EMAIL PROTECTED] in debugger
gives: Bizarre copy of ARRAY in leave
From: Robin Houston <[EMAIL PROTECTED]>
Date: Oct 14, 2005 1:54 AM
Message-ID: <[EMAIL PROTECTED]>
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
... //depot/maint-5.8/perl/global.sym#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
... //depot/maint-5.8/perl/t/op/array.t#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.fnc 2007-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 |OP * |doref |NN OP *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 |OP* |prepend_elem |I32 optype|NULLOK OP* head|NULLOK OP* tail
p |void |push_return |NULLOK OP* o
Ap |void |push_scope
-Amb |OP* |ref |NULLOK OP* o|I32 type
+p |OP* |ref |NULLOK OP* o|I32 type
p |OP* |refkids |NULLOK OP* o|I32 type
Ap |void |regdump |NN const regexp* r
Ap |SV* |regclass_swash |NN struct regnode *n|bool doinit|NULLOK SV
**listsvp|NULLOK 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.h 2007-02-09 09:20:56.000000000 -0800
@@ -641,7 +641,6 @@
#define call_pv Perl_call_pv
#define call_sv Perl_call_sv
#define despatch_signals Perl_despatch_signals
-#define doref Perl_doref
#define eval_pv Perl_eval_pv
#define eval_sv Perl_eval_sv
#define get_sv Perl_get_sv
@@ -675,6 +674,7 @@
#endif
#define push_scope Perl_push_scope
#ifdef PERL_CORE
+#define ref Perl_ref
#define refkids Perl_refkids
#endif
#define regdump Perl_regdump
@@ -1686,6 +1686,11 @@
#ifdef PERL_CORE
#define my_swabn Perl_my_swabn
#endif
+#define gv_fetchpvn_flags Perl_gv_fetchpvn_flags
+#define gv_fetchsv Perl_gv_fetchsv
+#ifdef PERL_CORE
+#define is_gv_magical_sv Perl_is_gv_magical_sv
+#endif
#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
@@ -1748,11 +1753,6 @@
#endif
#ifndef HAS_STRLCPY
#endif
-#define gv_fetchpvn_flags Perl_gv_fetchpvn_flags
-#define gv_fetchsv Perl_gv_fetchsv
-#ifdef PERL_CORE
-#define is_gv_magical_sv Perl_is_gv_magical_sv
-#endif
#ifndef SPRINTF_RETURNS_STRLEN
#endif
#define ck_anoncode Perl_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_CORE
+#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_CORE
#define my_swabn Perl_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_CORE
+#define is_gv_magical_sv(a,b) Perl_is_gv_magical_sv(aTHX_ a,b)
+#endif
#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
#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_CORE
-#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)
==== //depot/maint-5.8/perl/global.sym#59 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#58~30021~ 2007-01-26 11:23:54.000000000 -0800
+++ perl/global.sym 2007-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.c 2007-02-09 09:20:56.000000000 -0800
@@ -67,6 +67,7 @@
PERL_CALLCONV 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.c 2007-02-09 09:20:56.000000000 -0800
@@ -1450,7 +1450,7 @@
}
OP *
-Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
+Perl_ref(pTHX_ OP *o, I32 type)
{
OP *kid;
@@ -1472,12 +1472,12 @@
case OP_COND_EXPR:
for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
- doref(kid, type, set_op_ref);
+ ref(kid, type);
break;
case OP_RV2SV:
if (type == OP_DEFINED)
o->op_flags |= OPf_SPECIAL; /* don't create GV */
- doref(cUNOPo->op_first, o->op_type, set_op_ref);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_PADSV:
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
@@ -1496,30 +1496,28 @@
case OP_RV2AV:
case OP_RV2HV:
- if (set_op_ref)
- o->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
/* FALL THROUGH */
case OP_RV2GV:
if (type == OP_DEFINED)
o->op_flags |= OPf_SPECIAL; /* don't create GV */
- doref(cUNOPo->op_first, o->op_type, set_op_ref);
+ ref(cUNOPo->op_first, o->op_type);
break;
case OP_PADAV:
case OP_PADHV:
- if (set_op_ref)
- o->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
break;
case OP_SCALAR:
case OP_NULL:
if (!(o->op_flags & OPf_KIDS))
break;
- doref(cBINOPo->op_first, type, set_op_ref);
+ ref(cBINOPo->op_first, type);
break;
case OP_AELEM:
case OP_HELEM:
- doref(cBINOPo->op_first, o->op_type, set_op_ref);
+ ref(cBINOPo->op_first, o->op_type);
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
: type == OP_RV2HV ? OPpDEREF_HV
@@ -1530,13 +1528,11 @@
case OP_SCOPE:
case OP_LEAVE:
- set_op_ref = FALSE;
- /* FALL THROUGH */
case OP_ENTER:
case OP_LIST:
if (!(o->op_flags & OPf_KIDS))
break;
- doref(cLISTOPo->op_last, type, set_op_ref);
+ ref(cLISTOPo->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.h 2007-02-09 09:20:56.000000000 -0800
@@ -518,10 +518,6 @@
#define PERL_LOADMOD_NOIMPORT 0x2
#define PERL_LOADMOD_IMPORT_OPS 0x4
-#if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C)
-#define ref(o, type) doref(o, type, TRUE)
-#endif
-
/* no longer used anywhere in core */
#ifndef PERL_CORE
#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.h 2007-02-09 09:20:56.000000000 -0800
@@ -1020,7 +1020,6 @@
PERL_CALLCONV I32 Perl_call_pv(pTHX_ const char* sub_name, I32 flags);
PERL_CALLCONV I32 Perl_call_sv(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV void Perl_despatch_signals(pTHX);
-PERL_CALLCONV OP * Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref);
PERL_CALLCONV SV* Perl_eval_pv(pTHX_ const char* p, I32 croak_on_error);
PERL_CALLCONV I32 Perl_eval_sv(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV SV* Perl_get_sv(pTHX_ const char* name, I32 create);
@@ -1047,7 +1046,7 @@
PERL_CALLCONV OP* Perl_prepend_elem(pTHX_ I32 optype, OP* head, OP* tail);
PERL_CALLCONV void Perl_push_return(pTHX_ OP* o);
PERL_CALLCONV void Perl_push_scope(pTHX);
-/* PERL_CALLCONV OP* ref(pTHX_ OP* o, I32 type); */
+PERL_CALLCONV OP* Perl_ref(pTHX_ OP* o, I32 type);
PERL_CALLCONV OP* Perl_refkids(pTHX_ OP* o, I32 type);
PERL_CALLCONV void Perl_regdump(pTHX_ const regexp* r);
PERL_CALLCONV SV* Perl_regclass_swash(pTHX_ struct regnode *n, bool
doinit, SV **listsvp, SV **altsvp);
==== //depot/maint-5.8/perl/t/op/array.t#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.t 2007-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 = (1..4);
- [EMAIL PROTECTED] = 7;
- is ($#{4}, 7);
-
- my $x;
- $#{$x} = 3;
- is(scalar @$x, 4);
-
- push @[EMAIL PROTECTED], 23;
- is ($4[8], 23);
-}
-{
- # Bug #37350 -- once more with a global
- use vars '@array';
- @array = (1..4);
- [EMAIL PROTECTED] = 7;
- is ($#{4}, 7);
-
- my $x;
- $#{$x} = 3;
- is(scalar @$x, 4);
-
- push @[EMAIL PROTECTED], 23;
- is ($4[8], 23);
-}
-
-# more tests for AASSIGN_COMMON
-
-{
our($x,$y,$z) = (1..3);
our($y,$z) = ($x,$y);
is("$x $y $z", "1 1 2");
End of Patch.
