[perl #58446] perl -d:DProf handles shift of @_ with & function wrong

# New Ticket Created by  tim@ubizen.com 
# Please include the string:  [perl #58446]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=58446 >



This is a bug report for perl from tim@ubuntu-sunray.be.ubizen.com,
generated with the help of perlbug 1.36 running under perl 5.10.0.


-----------------------------------------------------------------
[Please enter your report here]

In perl, it is possible to call a function, &foo; where @_ is actually shared,
if in foo the @_ is shifted, the surrounding function will see that in it's @_,
as it is in fact the same. This is documented in "Scoping issues", funny title
for a section tough :-).

DProf doesn't handle it very well. XML::Simple 2.16 for instance uses this
feature. I needed to do profiling for a performance issue, and I came across
this issue. This was on ubuntu 8.04.1 64-bit perl 5.8.8, perl 5.8.2 on solaris
8, CentOS 4.5's perl, and as requested in the manpage of perlbug, tested with
the newest 5.10.0 (as in this bugreport).

Sample code to test with:

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

package Aaa;

my $i = 0;

sub new {
    return bless { i => $i++ }, 'Aaa';
}

sub oeps {
    my $self = &shiftsome;

    print "Arg0:$_[0]\n";
    print "Arg1:$_[1]\n";
}

sub shiftsome {
    my $self;
    if($_[0]  and  UNIVERSAL::isa($_[0], 'Aaa')) {
        print "shifting!\n";
        $self = shift;
    } else {
        $self = Aaa->new();
    }
    
    return $self;
}

package main;


my $a = Aaa->new();

print "Class Method:\n";
$a->oeps('one', 'two', 'three');

print "Function Method:\n";
Aaa::oeps('one (again)', 'two (again)', 'three (again)');
-----------------------

This sample is constructed after XML::Simple's problem, and can probably even
be made smaller. Run it without profiling:
tim@ubuntu-sunray(0):~/work > perl bug.pl
Class Method:
shifting!
Arg0:one
Arg1:two
Function Method:
Arg0:one (again)
Arg1:two (again)

Run it with profiling:
tim@ubuntu-sunray(0):~/work > perl -d:DProf bug.pl
Class Method:
shifting!
Arg0:Aaa=HASH(0x6307e0)
Arg1:one
Function Method:
Arg0:one (again)
Arg1:two (again)


Arg0 is wrong here. It's not a bug in perl as it is documented, it's not a bug
in XML::Simple (albeit some a funny feature), so I guess it's one in the
default profiler for perl. This is also the reason why I file this bug with the
'core' category.


Tim


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

Configured by tim at Fri Aug 29 12:30:55 CEST 2008.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.24-19-generic, archname=x86_64-linux-thread-multi
    uname='linux ubuntu-sunray 2.6.24-19-generic #1 smp wed jun 18 14:15:37 utc 2008 x86_64 gnulinux '
    config_args='-Dusethreads -Duse5005threads -des -Duseshrplib -Dcc=gcc -Uinstallusrbinperl -Dprefix=/var/tmp/prltest5.10'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='4.2.3 (Ubuntu 4.2.3-2ubuntu7)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
    libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=/lib/libc-2.7.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.7'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/var/tmp/prltest5.10/lib/perl5/5.10.0/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib'

Locally applied patches:
    

---
@INC for perl 5.10.0:
    /home/tim/work//Components-OG-SEAM/SEAM/lib/perl
    /home/tim/work//Components-OG-SEAM/Util/lib/perl
    /home/tim/work//Components-OG-SEAM/ECPL/lib/perl
    /home/tim/work//Components-OG-SEAM/FirewallMon/lib
    /home/tim/work//Components-OG-SEAM/Core/lib
    /home/tim/work//Components-OG-SEAM/OGEnv/lib
    /home/tim/work//Components-OG-SEAM/OGEnv/lib/perl
    /home/tim/work//Components-OG-SEAM/lib
    /home/tim/work//Components-OG-SEAM/NIDM/lib
    /home/tim/work//Components-OG-SEAM/PCM/lib
    /home/tim/work//Components-OG-SEAM/Agreement
    /home/tim/work//Components-OG-SEAM/Signature/lib/perl
    /home/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/etm/modules
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.8
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.8/x86_64-linux-gnu-thread-multi
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.8
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.8/x86_64-linux-gnu-thread-multi
    /home/tim/infra_perllib/ubuntu-sunray/share/perl/site_perl/5.8.8
    /home/tim/infra_perllib/ubuntu-sunray/share/perl/site_perl/5.8.8/x86_64-linux-gnu-thread-multi
    /home/tim/infra_perllib/ubuntu-sunray/share/perl/5.8.8
    /home/tim/infra_perllib/ubuntu-sunray/share/perl/5.8.8/x86_64-linux-gnu-thread-multi
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl/site_perl/5.8.8
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl/site_perl/5.8.8/x86_64-linux-gnu-thread-multi
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl/5.8.8
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl/5.8.8/x86_64-linux-gnu-thread-multi
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.0
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.0/x86_64-linux-gnu-thread-multi
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.0
    /home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.0/x86_64-linux-gnu-thread-multi
    /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi
    /var/tmp/prltest5.10/lib/perl5/5.10.0/x86_64-linux-thread-multi
    /var/tmp/prltest5.10/lib/perl5/5.10.0
    /var/tmp/prltest5.10/lib/perl5/site_perl/5.10.0/x86_64-linux-thread-multi
    /var/tmp/prltest5.10/lib/perl5/site_perl/5.10.0
    .

---
Environment for perl 5.10.0:
    HOME=/home/tim
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH=:/lib32:/lib:/usr/local/lib:/home/tim/infra_perllib/ubuntu-sunray/lib
    LOGDIR (unset)
    PATH=/opt/og3/bin:/opt/og3/bin:/home/tim/work/local/bin:~/local/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/opt/instantclient_11_1:/opt/instantclient_11_1:/usr/sbin:/bin:/home/tim/work/local/bin:/opt/starteam-en-8.0.0-java/bin:/opt/apache-ant-1.6.5/bin:/home/tim/work//Components-OG-SEAM/SEAM/bin:/home/tim/work//Components-OG-SEAM/ECPL/bin/:/home/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/etm/bin:/home/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/og/bin/eventgenerator:/home/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/og/scripts:/usr/sbin:/bin:/home/tim/work/local/bin:/opt/starteam-en-8.0.0-java/bin:/opt/apache-ant-1.6.5/bin:/home/tim/work//Components-OG-SEAM/SEAM/bin:/home/tim/work//Components-OG-SEAM/ECPL/bin/:/home/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/etm/bin:/home/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/og/bin/eventgenerator:/ho
 me/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/og/scripts
    PERL5LIB=:/home/tim/work//Components-OG-SEAM/SEAM/lib/perl:/home/tim/work//Components-OG-SEAM/Util/lib/perl:/home/tim/work//Components-OG-SEAM/ECPL/lib/perl:/home/tim/work//Components-OG-SEAM/FirewallMon/lib:/home/tim/work//Components-OG-SEAM/Core/lib:/home/tim/work//Components-OG-SEAM/OGEnv/lib::/home/tim/work//Components-OG-SEAM/OGEnv/lib/perl:/home/tim/work//Components-OG-SEAM/lib:/home/tim/work//Components-OG-SEAM/NIDM/lib:/home/tim/work//Components-OG-SEAM/PCM/lib:/home/tim/work//Components-OG-SEAM/Agreement:/home/tim/work//Components-OG-SEAM/Signature/lib/perl:/home/tim/work//Teams-Infrastructure/Components/ManagementStation/opt/etm/modules:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.8:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.8/x86_64-linux-gnu-thread-multi:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.8:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.8/x86_64-linux-gnu-thread-multi:/home/tim/infra_perllib/ubuntu-sunr
 ay/share/perl/site_perl/5.8.8:/home/tim/infra_perllib/ubuntu-sunray/share/perl/site_perl/5.8.8/x86_64-linux-gnu-thread-multi:/home/tim/infra_perllib/ubuntu-sunray/share/perl/5.8.8:/home/tim/infra_perllib/ubuntu-sunray/share/perl/5.8.8/x86_64-linux-gnu-thread-multi:/home/tim/infra_perllib/ubuntu-sunray/lib/perl/site_perl/5.8.8:/home/tim/infra_perllib/ubuntu-sunray/lib/perl/site_perl/5.8.8/x86_64-linux-gnu-thread-multi:/home/tim/infra_perllib/ubuntu-sunray/lib/perl/5.8.8:/home/tim/infra_perllib/ubuntu-sunray/lib/perl/5.8.8/x86_64-linux-gnu-thread-multi:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.0:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/site_perl/5.8.0/x86_64-linux-gnu-thread-multi:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.0:/home/tim/infra_perllib/ubuntu-sunray/lib/perl5/5.8.0/x86_64-linux-gnu-thread-multi:/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi
    PERL_BADLANG (unset)
    SHELL=/bin/bash

• [perl #58446] perl -d:DProf handles shift of @_ with & function wrong by perlbug-followup