develooper Front page | perl.perl5.porters | Postings from February 2007

Re: Future Perl development

Thread Previous | Thread Next
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");

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About