Caller inside BEGIN block return wrong info

[p5pRT]

Migrated from rt.perl.org#127083 (status was 'open')

Searchable as RT127083$

[p5pRT]

From @KES777

Created by @KES777

$cat t.pl
#!/usr/bin/env perl

BEGIN {
  local $" = ' - ';
  my $level = 0;
  while( my @​frame = caller( $level++ ) ) {
  print "@​frame[0..3]\n";
  }
  print "\n";
}

use Mod2;

$cat Mod2.pm
package Mod2;
#2
#3
#4
BEGIN {
  local $" = ' - ';
  my $level = 0;
  while( my @​frame = caller( $level++ ) ) {
  print "@​frame[0..3]\n";
  }
  print "\n";
}

use Mod1;

1;

$cat Mod1.pm
package Mod1;
#2
#3
#4
#5
#6
BEGIN {
  local $" = ' - ';
  my $level = 0;
  while( my @​frame = caller( $level++ ) ) {
  print "@​frame[0..3]\n";
  }
  print "\n";
}

1;

The output is​:
main - ./t.pl - 10 - main​::BEGIN
main - ./t.pl - 10 - (eval)

main - Mod2.pm - 12 - Mod2​::BEGIN
main - Mod2.pm - 12 - (eval)
main - ./t.pl - 12 - (eval)
main - Mod2.pm - 12 - main​::BEGIN
main - Mod2.pm - 12 - (eval)

main - Mod1.pm - 14 - Mod1​::BEGIN
main - Mod1.pm - 14 - (eval)
Mod2 - Mod2.pm - 14 - (eval)
main - Mod1.pm - 14 - Mod2​::BEGIN
main - Mod1.pm - 14 - (eval)
main - ./t.pl - 12 - (eval)
main - Mod1.pm - 14 - main​::BEGIN
main - Mod1.pm - 14 - (eval)

It is not expected that the information about last frames is changed.
I think that the call to 'caller' from Mod1 should look like​:
main - Mod1.pm - 14 - Mod1​::BEGIN
main - Mod1.pm - 14 - (eval)
Mod2 - Mod2.pm - 14 - (eval)
main - Mod2.pm - 12 - Mod2​::BEGIN
main - Mod2.pm - 12 - (eval)
main - ./t.pl - 12 - (eval)
main - ./t.pl - 10 - main​::BEGIN
main - ./t.pl - 10 - (eval)

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.22.0:

Configured by kes at Tue Sep 29 16:12:55 EEST 2015.

Summary of my perl5 (revision 5 version 22 subversion 0) configuration:
   
  Platform:
    osname=linux, osvers=3.13.0-37-generic, archname=x86_64-linux
    uname='linux keswork 3.13.0-37-generic #64-ubuntu smp mon sep 22 21:28:38 utc 2014 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Dprefix=/home/kes/perl'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.8.4', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/4.8/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.19.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.19'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector'



@INC for perl 5.22.0:
    /home/kes/work/projects/perl_libs/lib
    /home/kes/perl5/lib/perl5/x86_64-linux
    /home/kes/perl5/lib/perl5
    /home/kes/perl/lib/site_perl/5.22.0/x86_64-linux
    /home/kes/perl/lib/site_perl/5.22.0
    /home/kes/perl/lib/5.22.0/x86_64-linux
    /home/kes/perl/lib/5.22.0
    .


Environment for perl 5.22.0:
    HOME=/home/kes
    LANG=ru_UA.UTF-8
    LANGUAGE=en
    LC_MESSAGES=en_US.UTF-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/kes/perl/bin:/home/kes/perl/bin:/home/kes/perl5/bin:/home/kes/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games
    PERL5DB=BEGIN { require "Devel/KillPrint.pm" }
    PERL5LIB=/home/kes/work/projects/perl_libs/lib:/home/kes/perl5/lib/perl5
    PERLDB_OPTS=RemotePort=keswork:9001
    PERL_BADLANG (unset)
    PERL_MB_OPT=--install_base "/home/kes/perl5"
    PERL_MM_OPT=INSTALL_BASE=/home/kes/perl5
    SHELL=/bin/bash

[p5pRT]

From @iabyn

On Wed, Dec 30, 2015 at 04​:31​:01AM -0800, KES wrote​:

It is not expected that the information about last frames is changed.
I think that the call to 'caller' from Mod1 should look like​:

Here's a slightly simplified example that only requires a single module​:

Mod.pm​:

  package Mod;
  BEGIN {
  print "MOD BEGIN​: ", :​:top_call(), "\n";
  }
  print "MOD​: ", :​:top_call(), "\n";

/tmp/t​:

  #return file and line of top-most level call site
  sub top_call {
  my $i = 0;
  my $where;
  while(my @​c = caller($i++)) {
  $where = "$c[1]​:$c[2]";
  }
  $where;
  }

  BEGIN {
  print "MAIN BEGIN​: ", :​:top_call(), "\n";
  require Mod;
  }

  sub f { print "f()​: ", :​:top_call(), "\n"; }
  f();

This code prints the outermost call-site at various places. It outputs​:

  MAIN BEGIN​: /tmp/t​:16
  MOD BEGIN​: /tmp/Mod.pm​:4
  MOD​: /tmp/Mod.pm​:0
  f()​: /tmp/t​:19

I'd expect the middle two to be

  MOD BEGIN​: /tmp/t​:16
  MOD​: /tmp/t​:16

instead, since they're both called from the BEGIN in /tmp/t.

Still present in blead.

--
O Unicef Clearasil!
Gibberish and Drivel!
  -- "Bored of the Rings"

[p5pRT]

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

[atoomic]

@iabyn was this fixed by f2f32cd and so we can close this case?

[iabyn]

Yes, this commit fixed the issue.

[haarg]

This change broke my module Devel::CompileLevel. The module works by modifying ${^WARNING_BITS}, then trying to detect those changes using the warnings bitmask returned by caller. Although this is a bit weird, it does seem like a reasonable thing to expect to work. The module doesn't have any users that I know of though.

[iabyn]

On Thu, Jan 02, 2020 at 09:06:54AM -0800, Graham Knop wrote: This change broke my module [Devel::CompileLevel] (https://metacpan.org/pod/Devel::CompileLevel). The module works by modifying `${^WARNING_BITS}`, then trying to detect those changes using the warnings bitmask returned by `caller`. Although this is a bit weird, it does seem like a reasonable thing to expect to work. The module doesn't have any users that I know of though.

As far as I can see your module was exploiting a bug which my change fixed. The caller() function is documented to return the hints "that the caller was compiled with". Since the chain of BEGIN and/or import() subs that you are scanning back over have all been compiled, it's actually a bug if changing ${^WARNING_BITS} changes what caller() reports. In addition, caller()'s docs say that "the $hints and $bitmask values are subject to change between versions of Perl, and are not meant for external use". So all in all, I'm sanguine about this change.

…

-- "You may not work around any technical limitations in the software" -- Windows Vista license

[haarg]

The location it's detecting is not a BEGIN or import, but the level just beyond the closest BEGIN. That level hasn't finished compiling yet. The module isn't depending on $bitmask having any specific value, only that it matches ${^WARNING_BITS} as the docs claim it will. And the value isn't being reused for anything external. So I don't think that part of the caller docs are particularly relevant.

I'm not particularly attached to the module though.