develooper Front page | perl.perl5.porters | Postings from October 2005

Re: [PATCH] Re: [perl #37350] $#{@$aref} in debugger gives: Bizarre copy of ARRAY in leave

Thread Previous | Thread Next
From:
Robin Houston
Date:
October 13, 2005 17:22
Subject:
Re: [PATCH] Re: [perl #37350] $#{@$aref} in debugger gives: Bizarre copy of ARRAY in leave
Message ID:
20051013235457.GA23386@rpc142.cs.man.ac.uk
Here is a version that uses a macro.

Do we need to be binary compatible? If not, the 'b' flag and
the Perl_ref() implementation can be scrapped. On the other
hand: if we're seriously worried about back-compat, and the
comment at the top of embed.fnc is to be believed, the doref
line should be moved to the end.

Also includes tests, which should be relevant whichever
implementation variant gets the green light.

Robin

--- embed.fnc.orig	2005-10-03 16:46:16.000000000 +0100
+++ embed.fnc	2005-10-14 00:23:43.000000000 +0100
@@ -589,6 +589,7 @@
 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
@@ -614,7 +615,7 @@
 Ap	|void	|pop_scope
 p	|OP*	|prepend_elem	|I32 optype|NULLOK OP* head|NULLOK OP* tail
 Ap	|void	|push_scope
-p	|OP*	|ref		|NULLOK OP* o|I32 type
+Amb	|OP*	|ref		|NULLOK OP* o|I32 type
 p	|OP*	|refkids	|NULLOK OP* o|I32 type
 Ap	|void	|regdump	|NN regexp* r
 Ap	|SV*	|regclass_swash	|NN const struct regnode *n|bool doinit|NULLOK SV **listsvp|NULLOK SV **altsvp
--- op.c.orig	2005-09-27 11:38:14.000000000 +0100
+++ op.c	2005-10-14 00:24:06.000000000 +0100
@@ -1412,7 +1412,7 @@
 }
 
 OP *
-Perl_ref(pTHX_ OP *o, I32 type)
+Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
 {
     dVAR;
     OP *kid;
@@ -1434,12 +1434,12 @@
 
     case OP_COND_EXPR:
 	for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
-	    ref(kid, type);
+	    doref(kid, type, set_op_ref);
 	break;
     case OP_RV2SV:
 	if (type == OP_DEFINED)
 	    o->op_flags |= OPf_SPECIAL;		/* don't create GV */
-	ref(cUNOPo->op_first, o->op_type);
+	doref(cUNOPo->op_first, o->op_type, set_op_ref);
 	/* FALL THROUGH */
     case OP_PADSV:
 	if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
@@ -1456,28 +1456,30 @@
 
     case OP_RV2AV:
     case OP_RV2HV:
-	o->op_flags |= OPf_REF;
+	if (set_op_ref)
+	    o->op_flags |= OPf_REF;
 	/* FALL THROUGH */
     case OP_RV2GV:
 	if (type == OP_DEFINED)
 	    o->op_flags |= OPf_SPECIAL;		/* don't create GV */
-	ref(cUNOPo->op_first, o->op_type);
+	doref(cUNOPo->op_first, o->op_type, set_op_ref);
 	break;
 
     case OP_PADAV:
     case OP_PADHV:
-	o->op_flags |= OPf_REF;
+	if (set_op_ref)
+	    o->op_flags |= OPf_REF;
 	break;
 
     case OP_SCALAR:
     case OP_NULL:
 	if (!(o->op_flags & OPf_KIDS))
 	    break;
-	ref(cBINOPo->op_first, type);
+	doref(cBINOPo->op_first, type, set_op_ref);
 	break;
     case OP_AELEM:
     case OP_HELEM:
-	ref(cBINOPo->op_first, o->op_type);
+	doref(cBINOPo->op_first, o->op_type, set_op_ref);
 	if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
 	    o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
 			      : type == OP_RV2HV ? OPpDEREF_HV
@@ -1488,11 +1490,13 @@
 
     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;
-	ref(cLISTOPo->op_last, type);
+	doref(cLISTOPo->op_last, type, set_op_ref);
 	break;
     default:
 	break;
@@ -1501,6 +1505,15 @@
 
 }
 
+/* ref() is now a macro using Perl_doref;
+ * this version provided for binary compatibility only.
+ */
+OP *
+Perl_ref(pTHX_ OP *o, I32 type)
+{
+    return doref(o, type, TRUE);
+}
+
 STATIC OP *
 S_dup_attrlist(pTHX_ OP *o)
 {
--- op.h.orig	2005-10-14 00:16:29.000000000 +0100
+++ op.h	2005-10-14 00:25:06.000000000 +0100
@@ -507,6 +507,9 @@
 #define PERL_LOADMOD_NOIMPORT		0x2
 #define PERL_LOADMOD_IMPORT_OPS		0x4
 
+/* used in perly.y */
+#define ref(o, type) doref(o, type, TRUE)
+
 #ifdef USE_REENTRANT_API
 #include "reentr.h"
 #endif
--- t/op/array.t.orig	2005-10-14 00:30:48.000000000 +0100
+++ t/op/array.t	2005-10-14 00:43:50.000000000 +0100
@@ -7,7 +7,7 @@
 
 require 'test.pl';
 
-plan (111);
+plan (117);
 
 #
 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -356,4 +356,32 @@
     }
 }
 
+{
+    # 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);
+}
+
 "We're included by lib/Tie/Array/std.t so we need to return something true";

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