Front page | perl.perl5.porters |
Postings from February 2007
Re: Future Perl development
From:
Nicholas Clark
Date:
February 9, 2007 10:47
Subject:
Re: Future Perl development
Message ID:
20070209184703.GR5748@plum.flirble.org
On Thu, Feb 08, 2007 at 08:40:42PM +0100, Slaven Rezic wrote:
> Nicholas Clark <nick@ccl4.org> writes:
>
> > On Wed, Feb 07, 2007 at 02:10:15PM -0800, Peter Scott wrote:
> >
> > > The more conventional construct $#$ref is evaluated
> > > identically. $#{@$ref} seems like it ought to be illegal, but clearly
> > > hasn't been hitherto, and I couldn't find anything in your changelog
> > > saying it had now been outlawed. Case referred to department of
> > > backward compatibility.
> >
> > It's a bug. I remember it being fixed.
> > My view is that Tk needs fixing. *that* could be slightly tricky.
>
> It's already fixed and will be in the 804.028 release. Or try it with
> the subversion repository
> https://svn.sourceforge.net/svnroot/srezic/Tk (will move to
> https://svn.perl.org/modules/Tk in a near future).
The backwards compatibility police had an impromtu meeting on London Bridge
station at 00:20 this morning. (Mostly thanks to First Capital Connect
deciding to cancel a train about 30 seconds after it was due to arrive,
with the indicator board saying that it was on schedule until this point)
We came to the view that if part of Tk has buggy code like this, and part
of $former_employer's code had (until I fixed it when testing with blead)
then it's likely that there is other code out there.
Also, just upgrading this Tk module might be tricky. So I reverted the
bug fix in maint.
Nicholas Clark
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@cpan.org>
Date: Oct 14, 2005 1:54 AM
Message-ID: <20051013235457.GA23386@rpc142.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
... //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) ====
@@ -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) ====
@@ -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) ====
@@ -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) ====
@@ -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) ====
@@ -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) ====
@@ -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) ====
@@ -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) ====
@@ -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);
- $#{@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 = (1..4);
- $#{@array} = 7;
- is ($#{4}, 7);
-
- my $x;
- $#{$x} = 3;
- is(scalar @$x, 4);
-
- push @{@array}, 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");