-
Notifications
You must be signed in to change notification settings - Fork 578
$#{@$aref} in debugger gives: Bizarre copy of ARRAY in leave #8138
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Comments
From [email protected]Created by [email protected]An example program: my $i; __END__ When run through the debugger (hence the -d on the shebang), and The error does not appear if the program is executed outside of The fact that $#{@$aref} is apparently an acceptable alternate Perl Info
|
From [email protected]Further examination reveals that the example program originally submitted is far more cluttered than is necessary: #!/usr/bin/perl my $i; my __END__ Running this program through the debugger produces the "Bizarre copy of ARRAY in leave" error. Running the program normally (outside the debugger) produces output as though Please note that removing the { } from @a causes normal execution of the script to produce much more expected results: Paul Lalli |
From [email protected]Lalli, Paul D wrote:
Yes, but you don't really want to do that. It should be because @array --> $#array Using arrays instead of references in curlies here is incorrect. Of I wonder what the prevalence of this contstruct is out in the wild. David
-- |
The RT System itself - Status changed from 'new' to 'open' |
From [email protected]lallip@cs.rpi.edu (via RT) wrote:
That's because perl is trying to do the right thing with bad syntax. for ($i=0; I suspect putting the code through Devel::Cover would have the same effect. Interestingly enough, after browsing through the documentation for a
Indeed. It is something that just mostly happens to work. For instance my (@even, @odd); is not supposed to work, but it does. (It should be push @{ $_ % 2 ? \@odd : \@even}, $_ for (0..20); in case you were wondering). The @{ ... } to push is supposed to take a Except under the debugger, or Devel::Cover. David
-- |
From [email protected]perlref.diff--- perlref.pod Tue Oct 11 18:55:13 2005
+++ perlref.pod.orig Tue Oct 11 18:47:23 2005
@@ -297,7 +297,6 @@
$bar = $$scalarref;
push(@$arrayref, $filename);
$$arrayref[0] = "January";
- $last = $#$arrayref;
$$hashref{"KEY"} = "VALUE";
&$coderef(1,2,3);
print $globref "output\n";
@@ -322,7 +321,6 @@
$bar = ${$scalarref};
push(@{$arrayref}, $filename);
${$arrayref}[0] = "January";
- $last = $#{$arrayref};
${$hashref}{"KEY"} = "VALUE";
&{$coderef}(1,2,3);
$globref->print("output\n"); # iff IO::Handle is loaded
|
From [email protected]David Landgren wrote:
Well yes, but that's still a bug because perl ought to reject bad One way to fix it is shown in the patch below. I added a new (HEALTH WARNING: I'm not sure that I picked a safe value for The other issue with this approach is that it presumably slows Robin Inline Patch--- op.c.orig 2005-10-11 22:03:08.000000000 +0100
+++ op.c 2005-10-11 22:56:42.000000000 +0100
@@ -1455,6 +1455,8 @@
break;
case OP_RV2AV:
+ if (type == OP_AV2ARYLEN)
+ o->op_private |= OPpRV2AV_REFONLY;
case OP_RV2HV:
o->op_flags |= OPf_REF;
/* FALL THROUGH */
--- op.h.orig 2005-10-11 22:03:20.000000000 +0100
+++ op.h 2005-10-11 22:51:59.000000000 +0100
@@ -177,6 +177,9 @@
#define OPpMAYBE_LVSUB 8 /* We might be an lvalue to return */
/* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */
+/* Private for OP_RV2AV */
+#define OPpRV2AV_REFONLY 64 /* Only accept an RV or GV, not an AV. */
+
/* Private for OPs with TARGLEX */
/* (lower bits may carry MAXARG) */
#define OPpTARGET_MY 16 /* Target is PADMY. */
--- pp_hot.c.orig 2005-10-11 22:01:22.000000000 +0100
+++ pp_hot.c 2005-10-11 22:56:03.000000000 +0100
@@ -696,7 +696,11 @@
else {
if (SvTYPE(sv) == SVt_PVAV) {
av = (AV*)sv;
- if (PL_op->op_flags & OPf_REF) {
+
+ if (PL_op->op_private & OPpRV2AV_REFONLY)
+ DIE(aTHX_ "Not an ARRAY reference");
+
+ else if (PL_op->op_flags & OPf_REF) {
SETs((SV*)av);
RETURN;
} |
From @ysthOn Tue, Oct 11, 2005 at 11:15:49PM +0100, Robin Houston wrote:
I think the problem is that that the first executed (of two) rv2av is $ perl -we'*1 = [qw/foo bar baz/]; @x=0; print $#{0+@x}' only without the 0+ being there. (If @x is lexical, then it's padav |
From @iabynOn Wed, Oct 12, 2005 at 02:18:12AM -0700, Yitzchak Scott-Thoennes wrote:
It's because Perl_ref() recursively sets the OPf_REF flag in the following | arylen %prec '(' /* That particuar problem can be fixed by replacing the call to ref() above -- |
From [email protected]
How true! Great, thanks. (I'm not sure whether to be sorry that I Even if we do nothing else, we should surely apply Dave Mitchell's Robin |
From @ysthOn Wed, Oct 12, 2005 at 12:42:14PM +0100, Dave Mitchell wrote:
I think it needs to be recursive, even there, because IMO this should $ perl -we'$#{$x}=3; print $x' The solution I'm thinking of would require another parameter to Perl_ref Does that sound like the right effect? Can you think of anything that |
From [email protected]On Wed, Oct 12, 2005 at 03:33:45PM -0700, Yitzchak Scott-Thoennes wrote:
That works great, and nothing seems to break. One implementation is below (run embed.pl after applying), though maybe for Robin Inline Patch--- embed.fnc.orig 2005-10-03 16:46:16.000000000 +0100
+++ embed.fnc 2005-10-13 11:03:02.000000000 +0100
@@ -1083,6 +1083,7 @@
s |const char* |gv_ename |NN GV *gv
s |bool |scalar_mod_type|NN const OP *o|I32 type
s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp
+s |OP * |doref |NN OP *o|I32 type|bool set_op_ref
s |OP * |dup_attrlist |NN OP *o
s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my
s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp
--- op.c.orig 2005-09-27 11:38:14.000000000 +0100
+++ op.c 2005-10-13 11:09:55.000000000 +0100
@@ -1411,8 +1411,8 @@
return o;
}
-OP *
-Perl_ref(pTHX_ OP *o, I32 type)
+STATIC OP *
+S_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,12 @@
}
+OP *
+Perl_ref(pTHX_ OP *o, I32 type)
+{
+ return doref(o, type, TRUE);
+}
+
STATIC OP *
S_dup_attrlist(pTHX_ OP *o)
{ |
From [email protected]Here is a version that uses a macro. Do we need to be binary compatible? If not, the 'b' flag and Also includes tests, which should be relevant whichever Robin Inline Patch--- 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"; |
From [email protected]Robin Houston wrote:
Does this patch make it work now under the dubber? David |
From [email protected]David Landgren wrote:
Gah. Debugger. And hit Enter too early. Does this by chance also happen push @{$_ % 2 ? @odd : @even} for 0..10 happen to work as well, or are other forces coming into play?
|
From [email protected]On Fri, Oct 14, 2005 at 10:16:01PM +0200, David Landgren wrote:
Yes. Robin |
From [email protected]On Fri, Oct 14, 2005 at 10:20:29PM +0200, David Landgren wrote:
Assuming you really meant: push @{$_ % 2 ? @odd : @even}, $_ for 0..10 it "works" in the sense that it's equivalent to @0 = (0..10); which presumably isn't what you meant. This: push @{$_ % 2 ? \@odd : \@even}, $_ for 0..10; does what I guess you want, but that hasn't changed. Robin |
From @rgarciaOn 10/14/05, Robin Houston <robin@cpan.org> wrote:
Thanks, applied as change #25808 to bleadperl.
Perl 5.10 won't be binary compatible with 5.8.x. It's thus not |
From [email protected]On Wed, Oct 19, 2005 at 11:15:10PM +0200, Rafael Garcia-Suarez wrote:
Is this a good opportunity to revisit the other related issue: Someone (I think it might have been me) added a warning at some In line with Yitzchak's observation about $#{@foo}, the "correct" If there's some sort of consensus that this is the right thing Robin |
From [email protected]On Oct 21, Robin Houston said:
I'm still amazed how some beginners FIND this artifact and use it -- |
From @AbigailOn Fri, Oct 21, 2005 at 02:47:54PM +0100, Robin Houston wrote:
Turning '@foo->[0]' to mean '("".@foo)->[0]' is going to solve what exactly? One of the features of Perl is it's DWIM. '@foo->[0]' does what people mean. Abigail |
From [email protected]On Fri, Oct 21, 2005 at 09:51:08PM +0200, Abigail wrote:
Yes, I suppose this is the obvious objection, and it has some force. "Any [programming] language that doesn't occasionally surprise the On the other hand, it *might* be possible to make this into an EXCEPT THAT if an array is used in a construct that expects an What are the places where such a rule would apply? @foo->[$n] of Of course this is the sort of change that would need Larry's blessing, Robin |
From @ysthOn Fri, Oct 21, 2005 at 09:51:08PM +0200, Abigail wrote:
The only gain would be in the "keeping the rules simple" front. I |
From @rgsMarking as fixed since the original error message doesn't occur anymore |
@rgs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#37350 (status was 'resolved')
Searchable as RT37350$
The text was updated successfully, but these errors were encountered: