$#{@$aref} in debugger gives: Bizarre copy of ARRAY in leave

[p5pRT]

Migrated from rt.perl.org#37350 (status was 'resolved')

Searchable as RT37350$

[p5pRT]

From lallip@cs.rpi.edu

Created by lallip@cs.rpi.edu

An example program​:
#!/usr/bin/perl -d
use strict;
use warnings;

my $i;
my $aref = [1..10];
for ($i=0; $i<=$#{@​$aref}; $i++){
  print "$i​: $aref->[$i]\n";
}

__END__

When run through the debugger (hence the -d on the shebang), and
entering the command of 'c', this program gives the following
debugger output​:
Bizarre copy of ARRAY in leave at ./debug.pl line 7.

The error does not appear if the program is executed outside of
the debugger.

The fact that $#{@​$aref} is apparently an acceptable alternate
syntax for $#{$aref} is also bizarre, and seems to be undocumented
(though that should, perhaps, be a different bug report)

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl v5.6.1:

Configured by jcutter at Thu Nov  8 13:16:27 EST 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
  Platform:
    osname=solaris, osvers=2.6, archname=sun4-solaris
    uname='sunos sunnybt1 5.6 generic_111446-02 sun4u sparc sunw,ultra-4 '
    config_args='-Dprefix=/opt/perl -D cc=gcc -des'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
  Compiler:
    cc='gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O',
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.2 19991024 (release)', gccosandvers='solaris2.8'
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, usemymalloc=y, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib '
    libpth=/usr/local/lib /usr/lib /usr/ccs/lib
    libs=-lsocket -lnsl -ldl -lm -lc
    perllibs=-lsocket -lnsl -ldl -lm -lc
    libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.6.1:
    /export/home/common/fdcs/DCS_Perl/sun4-solaris
    /export/home/common/fdcs/DCS_Perl
    /export/home/common/fdcs/bin
    /home/plalli/lib/site_perl/5.6.1//sun4-solaris
    /home/plalli/lib/site_perl/5.6.1/
    /opt/perl/lib/5.6.1/sun4-solaris
    /opt/perl/lib/5.6.1
    /opt/perl/lib/site_perl/5.6.1/sun4-solaris
    /opt/perl/lib/site_perl/5.6.1
    /opt/perl/lib/site_perl
    .


Environment for perl v5.6.1:
    HOME=/home/plalli
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/opt/inf92/lib/esql:/opt/inf92/lib:/usr/lib:/opt/inf92/lib/tools
    LOGDIR (unset)
    PATH=.:/home/plalli/bin:/home/jpasqual/setup:/opt/perl/bin:/opt/SUNWspro/bin:/usr/bin:/usr/ccs/bin:.:/home/plalli/local_bin:/opt/inf92/bin:/usr/ucb:/opt/inf92/bin:/usr/bin:/opt:/opt/WorkShop/SUNWspro/bin:/opt/SUNWspro/bin:/usr/dt/bin:/usr/openwin/bin:/bin:/usr/bin:/usr/ucb:/usr/openwin/bin:/usr/ucb:/etc:/usr/local/bin:/usr/ccs/bin:/home/jpasqual/setup:/usr/local/parasoft/bin.solaris:/opt/perl/bin:.
    PERL5LIB=/export/home/common/fdcs/DCS_Perl:/export/home/common/fdcs/bin:/home/plalli/lib/site_perl/5.6.1/
    PERL_BADLANG (unset)
    SHELL=/bin/ksh

--
Paul Lalli
Libris Information Solutions
69 State Street
Albany, NY 12207

Phone: 518-626-2232
Cel: 518-312-9362
Fax:     518-471-1880
Mail Stop: NY6-100-07-01
Paul.D.Lalli@BankOfAmerica.com
 <<ole0.bmp>> 

Because we value our relationship with you, we would like to offer you the opportunity to "opt out" of future e-mails. If at any time you would like to be removed from my e-mail list, please reply to this message indicating your request.

This e-mail contains information intended only for the use of the individual or entity named above. If you are not the intended recipient, delete or discard this message. It has been prepared solely for information purposes from sources believed to be reliable, is not intended as specific advice or recommendation, and is not a solicitation, commitment or offer. Although this message and any attachments are believed to be free of any virus or other defect that might affect any computer system into which it is received and opened, it is the responsibility of the recipient to ensure that it is virus-free. We accept no responsibility for any loss or damage arising in any way from its use.

Regular Internet e-mail is not secure. We ask that you do not send personal or company information of a sensitive or confidential nature through regular e-mail. For questions concerning your account relationships with Bank of America, you may contact us by phone, in person or via our secure "Contact Us" e-mail at www.bankofamerica.com. We do provide encrypted Internet e-mail services for certain online products and services for registered clients.

Bank of America, 100 N. Tryon Street, Charlotte, NC 28255-0001

[p5pRT]

From lallip@cs.rpi.edu

ole0.bmp

[p5pRT]

From lallip@cs.rpi.edu

Further examination reveals that the example program originally submitted is far more cluttered than is necessary​:

#!/usr/bin/perl
use strict;
use warnings;

my $i;
my @​a = (1..10);

my $last = $#{@​a};
print "Last index​: $last\n";

__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 $last had been assigned to $#a.

Please note that removing the { } from @​a causes normal execution of the script to produce much more expected results​:
Use of $# is deprecated at <file> line 8.
Array found where operator expected at <file> line 8, at end of line
  (Missing operator before ?)
syntax error at <file> line 8, near "$#@​a"
Execution of <file> aborted due to compilation errors.

Paul Lalli

[p5pRT]

From david@landgren.net

Lalli, Paul D wrote​:

Further examination reveals that the example program originally submitted is far more cluttered than is necessary​:

#!/usr/bin/perl
use strict;
use warnings;

my $i;
my @​a = (1..10);

my $last = $#{@​a};
print "Last index​: $last\n";

Yes, but you don't really want to do that. It should be

  $last = $#a;

because

  @​array --> $#array
  $arrayref --&gt; $#$arrayref

Using arrays instead of references in curlies here is incorrect. Of
course the annoying thing is that in ordinary circumstances it runs just
fine.

I wonder what the prevalence of this contstruct is out in the wild.
Unfortunately I can't pull anything out of gonzui. I tried $#{@​ and
\$#\{\@​\w+\} without success.

David

__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 $last had been assigned to $#a.

Please note that removing the { } from @​a causes normal execution of the script to produce much more expected results​:
Use of $# is deprecated at <file> line 8.
Array found where operator expected at <file> line 8, at end of line
(Missing operator before ?)
syntax error at <file> line 8, near "$#@​a"
Execution of <file> aborted due to compilation errors.

Paul Lalli

--
"It's overkill of course, but you can never have too much overkill."

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From david@landgren.net

lallip@​cs.rpi.edu (via RT) wrote​:

# New Ticket Created by lallip@​cs.rpi.edu
# Please include the string​: [perl #37350]
# in the subject line of all future correspondence about this issue.
# <URL​: https://rt-archive.perl.org/perl5/Ticket/Display.html?id=37350 >

This transaction appears to have no content

------------------------------------------------------------------------

To​: perlbug@​perl.org
Subject​: $#{@​$aref} in debugger gives​: Bizarre copy of ARRAY in leave
Reply-To​: lallip@​cs.rpi.edu

This is a bug report for perl from lallip@​cs.rpi.edu,
generated with the help of perlbug 1.33 running under perl v5.6.1.

-----------------------------------------------------------------
[Please enter your report here]
An example program​:
#!/usr/bin/perl -d
use strict;
use warnings;

my $i;
my $aref = [1..10];
for ($i=0; $i&lt;=$#{@​$aref}; $i++){
print "$i​: $aref->[$i]\n";
}

__END__

When run through the debugger (hence the -d on the shebang), and
entering the command of 'c', this program gives the following
debugger output​:
Bizarre copy of ARRAY in leave at ./debug.pl line 7.

That's because perl is trying to do the right thing with bad syntax.
What you really want to do is

  for ($i=0; $i&lt;=$#$aref; $i++){

I suspect putting the code through Devel​::Cover would have the same effect.

Interestingly enough, after browsing through the documentation for a
while, I couldn't find a discussion on the matter. C<perlref> would be
the obvious place but it is silent. At the risk of weighing down the
creaking documentation with another small addition (it's only wafer
thin), I have attached a small patch which adds an example to C<perlref>.

The error does not appear if the program is executed outside of
the debugger.

The fact that $#{@​$aref} is apparently an acceptable alternate
syntax for $#{$aref} is also bizarre, and seems to be undocumented
(though that should, perhaps, be a different bug report)

Indeed. It is something that just mostly happens to work.

For instance

  my (@​even, @​odd);
  push @​{ $_ % 2 ? @​odd : @​even}, $_ for (0..20);
  print "even @​even\nodd @​odd\n";

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
reference, instead, it's given an array. Surprisingly (to me, at least),
this works.

Except under the debugger, or Devel​::Cover.

David

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags​:
category=core
severity=low
---
Site configuration information for perl v5.6.1​:

Configured by jcutter at Thu Nov 8 13​:16​:27 EST 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration​:
Platform​:
osname=solaris, osvers=2.6, archname=sun4-solaris
uname='sunos sunnybt1 5.6 generic_111446-02 sun4u sparc sunw,ultra-4 '
config_args='-Dprefix=/opt/perl -D cc=gcc -des'
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
Compiler​:
cc='gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O',
cppflags='-fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='2.95.2 19991024 (release)', gccosandvers='solaris2.8'
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, usemymalloc=y, prototype=define
Linker and Libraries​:
ld='gcc', ldflags =' -L/usr/local/lib '
libpth=/usr/local/lib /usr/lib /usr/ccs/lib
libs=-lsocket -lnsl -ldl -lm -lc
perllibs=-lsocket -lnsl -ldl -lm -lc
libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
Dynamic Linking​:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'

Locally applied patches​:

---
@​INC for perl v5.6.1​:
/export/home/common/fdcs/DCS_Perl/sun4-solaris
/export/home/common/fdcs/DCS_Perl
/export/home/common/fdcs/bin
/home/plalli/lib/site_perl/5.6.1//sun4-solaris
/home/plalli/lib/site_perl/5.6.1/
/opt/perl/lib/5.6.1/sun4-solaris
/opt/perl/lib/5.6.1
/opt/perl/lib/site_perl/5.6.1/sun4-solaris
/opt/perl/lib/site_perl/5.6.1
/opt/perl/lib/site_perl
.

---
Environment for perl v5.6.1​:
HOME=/home/plalli
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH=/opt/inf92/lib/esql​:/opt/inf92/lib​:/usr/lib​:/opt/inf92/lib/tools
LOGDIR (unset)
PATH=.​:/home/plalli/bin​:/home/jpasqual/setup​:/opt/perl/bin​:/opt/SUNWspro/bin​:/usr/bin​:/usr/ccs/bin​:.​:/home/plalli/local_bin​:/opt/inf92/bin​:/usr/ucb​:/opt/inf92/bin​:/usr/bin​:/opt​:/opt/WorkShop/SUNWspro/bin​:/opt/SUNWspro/bin​:/usr/dt/bin​:/usr/openwin/bin​:/bin​:/usr/bin​:/usr/ucb​:/usr/openwin/bin​:/usr/ucb​:/etc​:/usr/local/bin​:/usr/ccs/bin​:/home/jpasqual/setup​:/usr/local/parasoft/bin.solaris​:/opt/perl/bin​:.
PERL5LIB=/export/home/common/fdcs/DCS_Perl​:/export/home/common/fdcs/bin​:/home/plalli/lib/site_perl/5.6.1/
PERL_BADLANG (unset)
SHELL=/bin/ksh

--
Paul Lalli
Libris Information Solutions
69 State Street
Albany, NY 12207

Phone​: 518-626-2232
Cel​: 518-312-9362
Fax​: 518-471-1880
Mail Stop​: NY6-100-07-01
Paul.D.Lalli@​BankOfAmerica.com
<<ole0.bmp>>

Because we value our relationship with you, we would like to offer you the opportunity to "opt out" of future e-mails. If at any time you would like to be removed from my e-mail list, please reply to this message indicating your request.

This e-mail contains information intended only for the use of the individual or entity named above. If you are not the intended recipient, delete or discard this message. It has been prepared solely for information purposes from sources believed to be reliable, is not intended as specific advice or recommendation, and is not a solicitation, commitment or offer. Although this message and any attachments are believed to be free of any virus or other defect that might affect any computer system into which it is received and opened, it is the responsibility of the recipient to ensure that it is virus-free. We accept no responsibility for any loss or damage arising in any way from its use.

Regular Internet e-mail is not secure. We ask that you do not send personal or company information of a sensitive or confidential nature through regular e-mail. For questions concerning your account relationships with Bank of America, you may contact us by phone, in person or via our secure "Contact Us" e-mail at www.bankofamerica.com. We do provide encrypted Internet e-mail services for certain online products and services for registered clients.

Bank of America, 100 N. Tryon Street, Charlotte, NC 28255-0001

------------------------------------------------------------------------

--
"It's overkill of course, but you can never have too much overkill."

[p5pRT]

From david@landgren.net

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

[p5pRT]

From robin@cpan.org

David Landgren wrote​:

That's because perl is trying to do the right thing with bad syntax.

Well yes, but that's still a bug because perl ought to reject bad
syntax! The reason it isn't rejected is that pp_rv2av will happily
accept an AV on the stack, in lieu of an actual reference. That
can't be changed in general, since it's relied on.

One way to fix it is shown in the patch below. I added a new
private flag to OP_RV2AV, which indicates that it shouldn't
accept a real AV.

(HEALTH WARNING​: I'm not sure that I picked a safe value for
the flag. Other values that I thought would be okay turned out
to cause problems, for some reason that I don't properly understand,
presumably connected to the hint bits. Maybe this just causes a
more subtle problem that evades the test suite. Can someone confirm
or deny that this is okay?)

The other issue with this approach is that it presumably slows
rv2av down very very slightly.

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;
 	    }

[p5pRT]

From @ysth

On Tue, Oct 11, 2005 at 11​:15​:49PM +0100, Robin Houston wrote​:

David Landgren wrote​:

That's because perl is trying to do the right thing with bad syntax.

Well yes, but that's still a bug because perl ought to reject bad
syntax! The reason it isn't rejected is that pp_rv2av will happily
accept an AV on the stack, in lieu of an actual reference. That
can't be changed in general, since it's relied on.

I think the problem is that that the first executed (of two) rv2av is
getting the OPf_REF flag set, when IMO it shouldn't. $#{@​x} *is*
valid syntax; it should return $# of the array symbolically referred
to by @​x, like this​:

$ perl -we'*1 = [qw/foo bar baz/]; @​x=0; print $#{0+@​x}'
2

only without the 0+ being there. (If @​x is lexical, then it's padav
that has the troublesome OPf_REF.)

[p5pRT]

From @iabyn

On Wed, Oct 12, 2005 at 02​:18​:12AM -0700, Yitzchak Scott-Thoennes wrote​:

I think the problem is that that the first executed (of two) rv2av is
getting the OPf_REF flag set, when IMO it shouldn't. $#{@​x} *is*
valid syntax; it should return $# of the array symbolically referred
to by @​x, like this​:

$ perl -we'*1 = [qw/foo bar baz/]; @​x=0; print $#{0+@​x}'
2

only without the 0+ being there. (If @​x is lexical, then it's padav
that has the troublesome OPf_REF.)

It's because Perl_ref() recursively sets the OPf_REF flag in the following
in perly.y​:

  | arylen %prec '(' /* $#x, $#{ something } */
  { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}

That particuar problem can be fixed by replacing the call to ref() above
with a direct $1->op_flags |= OPf_REF, but that doesn't solve the more
general problem with things like push @​{@​a}, ...., which also gets the
recursive Perl_ref() treatment. Possibly it can be fixed in Perl_ref()?

--
Art is anything that has a label (especially if the label is "untitled 1")

[p5pRT]

From robin@cpan.org

I think the problem is that that the first executed (of two) rv2av
is getting the OPf_REF flag set, when IMO it shouldn't. $#{@​x} *is*
valid syntax; it should return $# of the array symbolically referred
to by @​x, like this​:

$ perl -we'*1 = [qw/foo bar baz/]; @​x=0; print $#{0+@​x}'
2

only without the 0+ being there. (If @​x is lexical, then it's padav
that has the troublesome OPf_REF.)

How true! Great, thanks. (I'm not sure whether to be sorry that I
posted something so wrong, or pleased that I got the ball rolling.)

Even if we do nothing else, we should surely apply Dave Mitchell's
suggestion which fixes this case. But of course a better fix would
be better.

Robin

[p5pRT]

From @ysth

On Wed, Oct 12, 2005 at 12​:42​:14PM +0100, Dave Mitchell wrote​:

On Wed, Oct 12, 2005 at 02​:18​:12AM -0700, Yitzchak Scott-Thoennes wrote​:

I think the problem is that that the first executed (of two) rv2av is
getting the OPf_REF flag set, when IMO it shouldn't. $#{@​x} *is*
valid syntax; it should return $# of the array symbolically referred
to by @​x, like this​:

$ perl -we'*1 = [qw/foo bar baz/]; @​x=0; print $#{0+@​x}'
2

only without the 0+ being there. (If @​x is lexical, then it's padav
that has the troublesome OPf_REF.)

It's because Perl_ref() recursively sets the OPf_REF flag in the following
in perly.y​:

|    arylen     %prec '\('                    /\* $\#x\, $\#\{ something \} \*/
        \{ $$ = newUNOP\(OP\_AV2ARYLEN\, 0\, ref\($1\, OP\_AV2ARYLEN\)\);\}

That particuar problem can be fixed by replacing the call to ref() above
with a direct $1->op_flags |= OPf_REF, but that doesn't solve the more
general problem with things like push @​{@​a}, ...., which also gets the
recursive Perl_ref() treatment. Possibly it can be fixed in Perl_ref()?

I think it needs to be recursive, even there, because IMO this should
continue to autovivify​:

$ perl -we'$#{$x}=3; print $x'
ARRAY(0x460f10)

The solution I'm thinking of would require another parameter to Perl_ref
to say whether it should set OPf_REF for PADAV, PADHV, RV2AV, and RV2HV.
All external calls would set it to true, and recursive calls would
propagate it, except for OP_SCOPE and OP_LEAVE, which would set it false.

Does that sound like the right effect? Can you think of anything that
would break? Can you think of a way to do it without adding a parameter?

[p5pRT]

From robin@cpan.org

On Wed, Oct 12, 2005 at 03​:33​:45PM -0700, Yitzchak Scott-Thoennes wrote​:

The solution I'm thinking of would require another parameter to Perl_ref
to say whether it should set OPf_REF for PADAV, PADHV, RV2AV, and RV2HV.
All external calls would set it to true, and recursive calls would
propagate it, except for OP_SCOPE and OP_LEAVE, which would set it false.

Does that sound like the right effect? Can you think of anything that
would break? Can you think of a way to do it without adding a parameter?

That works great, and nothing seems to break.

One implementation is below (run embed.pl after applying), though maybe for
performance reasons doref should be external and ref() should be a macro?

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)
 {

[p5pRT]

From robin@cpan.org

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

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";

[p5pRT]

From david@landgren.net

Robin Houston wrote​:

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.

Does this patch make it work now under the dubber?

David