File content is used as subroutine name when exception occur while eval'ing from sub DB::DB{ ... }

[KES777]

Description

Steps to Reproduce
Do not have exact steps to reproduce.

1. Configure your apache2 to use Apache::ASP

PerlModule  Apache::ASP
PerlSetVar Debug 3

<VirtualHost *:8389>
    ServerName  your.domain.example.com
    DocumentRoot /path/to/your/pages
    DirectoryIndex index.html index.asp

    <Directory "/path/to/your/pages">
        AllowOverride None

        Order Allow,Deny
        Allow from all
    </Directory>

    <FilesMatch "\.asp$">
        SetHandler  perl-script
        PerlHandler Apache::ASP
        PerlSetVar  Global /path/to/your/project/lib
        PerlSetVar  StateDir /tmp/asp
        PerlSetVar  RequestParams 1
        PerlSetVar  XMLSubsMatch Site:\w+
        PerlSetVar  SessionTimeout 600
        PerlSetVar  UriProtocol https
        PerlSetVar  DocRoot /path/to/your/pages
        PerlSetVar  UrlRoot your.domain.example.com:8389
        PerlSetVar RequestBinaryRead On
        PerlSetVar Debug 3
    </FilesMatch>


    CustomLog /var/log/httpd/vhosts/eugen.access combined
    ErrorLog /var/log/httpd/vhosts/eugen.error

</VirtualHost>

2. Create file global.asa under /path/to/your/project/lib

use Apache::DB;

BEGIN{ Apache::DB::init(); }
use DB::Hooks qw'::Terminal ::Server ::TraceVariable NonStop';
BEGIN{ $DB::single = 1; 1; }  # write sub to dump stackframes from `caller()` here
BEGIN{ DB::x; 1; }

...
other subs

3. The dump:

DBG> 'asd
ERROR: Can't find string terminator '"' anywhere before EOF at (eval 78)[/usr/local/share/perl/5.34.0/DB/Hooks.pm:426] line 8.
 at (eval 78)[/usr/local/share/perl/5.34.0/DB/Hooks.pm:426] line 8.
	eval '' called at /usr/local/share/perl/5.34.0/DB/Hooks.pm line 426
	DB::eval(undef) called at /usr/local/share/perl/5.34.0/DB/Utils.pm line 476
	DB::process(CODE(0x562a421a5ae8)) called at /usr/local/share/perl/5.34.0/DB/Utils.pm line 456
	DB::emit("interact") called at /usr/local/share/perl/5.34.0/DB/Hooks.pm line 569
	DB::interact called at /usr/local/share/perl/5.34.0/DB/Hooks.pm line 155
	DB::dbcall(1, ARRAY(0x562a41f1f2c0), CODE(0x562a42059c88), "/path/to/your/project/lib/global.asa", 5) called at /usr/local/share/perl/5.34.0/DB/Hooks.pm line 580
	DB::db(ARRAY(0x562a41f1f2c0)) called at /usr/local/share/perl/5.34.0/DB/Hooks.pm line 590
	DB::DB called at /path/to/your/project/lib/global.asa line 5
	Apache::ASP::Compiles::__ASP_k_projects_project_app_apache_libxc2ec5c5203a4bd86213ff307cfa7bbbb::BEGIN() called at (eval 78)[/usr/local/share/perl/5.34.0/DB/Hooks.pm:426] line 8
	eval {...} called at (eval 78)[/usr/local/share/perl/5.34.0/DB/Hooks.pm:426] line 8
	eval '              <<<<<<< I expect (eval) here, instead of all this:
#line 1 /path/to/your/project/lib/global.asa
package Apache::ASP::Compiles::__ASP_k_projects_project_app_apache_libxc2ec5c5203a4bd86213ff307cfa7bbbb; ;; no strict ;; use vars qw($Application $Session $Response $Server $Request); ;; use lib qw(/path/to/your/project/lib); ;; use Apache::DB;

BEGIN{ Apache::DB::init(); }
use DB::Hooks qw\'::Terminal ::Server ::TraceVariable NonStop\';
BEGIN{ $DB::single = 1; 1; }
BEGIN{ DB::x; 1; }

...
other subs
 ;; sub exit { $main::Response->End(); }  ;; no lib qw(/path/to/your/project/lib); ;; 1;' called at /usr/local/share/perl/5.34.0/Apache/ASP/GlobalASA.pm line 124
	Apache::ASP::GlobalASA::new(Apache::ASP=HASH(0x562a412c1df0)) called at /usr/local/share/perl/5.34.0/Apache/ASP.pm line 389
	Apache::ASP::new("Apache::ASP", Apache2::RequestRec=SCALAR(0x562a41c6bbe0), "/path/to/your/pages/index.asp") called at /usr/local/share/perl/5.34.0/Apache/ASP.pm line 184
	Apache::ASP::handler(Apache2::RequestRec=SCALAR(0x562a41c6bbe0)) called at (eval 78)[/usr/local/share/perl/5.34.0/DB/Hooks.pm:426] line 8
	eval {...} called at (eval 78)[/usr/local/share/perl/5.34.0/DB/Hooks.pm:426] line 8

You can notice the long subroutine name

eval '
#line 1 /path/to/your/project/lib/global.asa
package Apache::ASP::Compiles::__ASP_k_projects_project_app_apache_libxc2ec5c5203a4bd86213ff307cfa7bbbb; ;; no strict ;; use vars qw($Application $Session $Response $Server $Request); ;; use lib qw(/path/to/your/project/lib); ;; use Apache::DB;

BEGIN{ Apache::DB::init(); }
use DB::Hooks qw\'::Terminal ::Server ::TraceVariable NonStop\';
BEGIN{ $DB::single = 1; 1; }
BEGIN{ DB::x; 1; }

...
other subs
 ;; sub exit { $main::Response->End(); }  ;; no lib qw(/path/to/your/project/lib); ;; 1;'

This happens when eveluating wrong expression inside debugger, eg. sub DB::DB { eval "'asd" }
Notice: line eval {...} called at (eval 78)[/usr/local/share/perl/5.34.0/DB/Hooks.pm:426] line 8
The line /usr/local/share/perl/5.34.0/DB/Hooks.pm:426 looks like this:

sub DB::eval {
   ...
   eval "$usercontext; package $pkg;\n$expr";  # line 426
}

where $expr is 'asd

Expected behavior
It should not be so long.

Though calling caller when no error occurs gives correct stack frames:

0 $ DB::frames(0) <--  /usr/local/share/perl/5.34.0/DB/Commands.pm:841
1 $ DB::Commands::cmd_stack_trace(0) <--  /usr/local/share/perl/5.34.0/DB/Commands.pm:107
2 $ (eval) <--  /usr/local/share/perl/5.34.0/DB/Commands.pm:107
3 $ DB::Commands::run(T 0) <--  /usr/local/share/perl/5.34.0/DB/Commands.pm:75
4 @ DB::Commands::interact() <--  /usr/local/share/perl/5.34.0/DB/Utils.pm:503
5 ; DB::process(CODE(0x562a421a5ae8)) <--  /usr/local/share/perl/5.34.0/DB/Utils.pm:456
6 ; DB::emit(interact) <--  /usr/local/share/perl/5.34.0/DB/Hooks.pm:569
7 @ DB::interact <--  /usr/local/share/perl/5.34.0/DB/Hooks.pm:155
8 @ DB::dbcall(1, ARRAY(0x562a41f1f2c0), CODE(0x562a42059c88), /path/to/your/project/lib/global.asa, 5) <--  /usr/local/share/perl/5.34.0/DB/Hooks.pm:580
9 @ DB::db(ARRAY(0x562a41f1f2c0)) <--  /usr/local/share/perl/5.34.0/DB/Hooks.pm:590
0 @ DB::DB <--  /path/to/your/project/lib/global.asa:5
1 ; Apache::ASP::Compiles::__ASP_k_projects_project_app_apache_libxc2ec5c5203a4bd86213ff307cfa7bbbb::BEGIN() <--  /path/to/your/project/lib/global.asa:5
2 ; (eval) <--  /path/to/your/project/lib/global.asa:5
3 ; (eval) <--  /usr/local/share/perl/5.34.0/Apache/ASP/GlobalASA.pm:124
4 $ Apache::ASP::GlobalASA::new(Apache::ASP=HASH(0x562a412c1df0)) <--  /usr/local/share/perl/5.34.0/Apache/ASP.pm:389
5 $ Apache::ASP::new(Apache::ASP, Apache2::RequestRec=SCALAR(0x562a41c6bbe0), /path/to/your/pages/index.asp) <--  /usr/local/share/perl/5.34.0/Apache/ASP.pm:184
6 $ Apache::ASP::handler(Apache2::RequestRec=SCALAR(0x562a41c6bbe0)) <--  /path/to/your/project/lib/global.asa:5
7 $ (eval) <--  /path/to/your/project/lib/global.asa:5

Notice line: 3 ; (eval) <-- /usr/local/share/perl/5.34.0/Apache/ASP/GlobalASA.pm:124
This is expected behavior.
But when exception happened we get that long file content instead of (eval) (see fifth stack frame from the end at the first example).

**Perl configuration**

Summary of my perl5 (revision 5 version 34 subversion 0) configuration:

Platform:
osname=linux
osvers=4.19.0
archname=x86_64-linux-gnu-thread-multi
uname='linux localhost 4.19.0 #1 smp debian 4.19.0 x86_64 gnulinux '
config_args='-Dmksymlinks -Dusethreads -Duselargefiles -Dcc=x86_64-linux-gnu-gcc -Dcpp=x86_64-linux-gnu-cpp -Dld=x86_64-linux-gnu-gcc -Dccflags=-DDEBIAN -Wdate-time -D_FORTIFY_SOURCE=2 -g -O2 -ffile-prefix-map=/dummy/build/dir=. -flto=auto -ffat-lto-objects -flto=auto -ffat-lto-objects -fstack-protector-strong -Wformat -Werror=format-security -Dldflags= -Wl,-Bsymbolic-functions -flto=auto -ffat-lto-objects -flto=auto -Wl,-z,relro -Dlddlflags=-shared -Wl,-Bsymbolic-functions -flto=auto -ffat-lto-objects -flto=auto -Wl,-z,relro -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.34 -Darchlib=/usr/lib/x86_64-linux-gnu/perl/5.34 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/x86_64-linux-gnu/perl5/5.34 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.34.0 -Dsitearch=/usr/local/lib/x86_64-linux-gnu/perl/5.34.0 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Duse64bitint -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Ui_libutil -Ui_xlocale -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -dEs -Duseshrplib -Dlibperl=libperl.so.5.34.0'
hint=recommended
useposix=true
d_sigaction=define
useithreads=define
usemultiplicity=define
use64bitint=define
use64bitall=define
uselongdouble=undef
usemymalloc=n
default_inc_excludes_dot=define
Compiler:
cc='x86_64-linux-gnu-gcc'
ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
optimize='-O2 -g'
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include'
ccversion=''
gccversion='11.2.0'
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='x86_64-linux-gnu-gcc'
ldflags =' -fstack-protector-strong -L/usr/local/lib'
libpth=/usr/local/lib /usr/lib/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib
libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=/lib/x86_64-linux-gnu/libc.so.6
so=so
useshrplib=true
libperl=libperl.so.5.34
gnulibc_version='2.35'
Dynamic Linking:
dlsrc=dl_dlopen.xs
dlext=so
d_dlsymun=undef
ccdlflags='-Wl,-E'
cccdlflags='-fPIC'
lddlflags='-shared -L/usr/local/lib -fstack-protector-strong'

Characteristics of this binary (from libperl):
Compile-time options:
HAS_TIMES
MULTIPLICITY
PERLIO_LAYERS
PERL_COPY_ON_WRITE
PERL_DONT_CREATE_GVSV
PERL_IMPLICIT_CONTEXT
PERL_MALLOC_WRAP
PERL_OP_PARENT
PERL_PRESERVE_IVUV
USE_64_BIT_ALL
USE_64_BIT_INT
USE_ITHREADS
USE_LARGE_FILES
USE_LOCALE
USE_LOCALE_COLLATE
USE_LOCALE_CTYPE
USE_LOCALE_NUMERIC
USE_LOCALE_TIME
USE_PERLIO
USE_PERL_ATOF
USE_REENTRANT_API
USE_THREAD_SAFE_LOCALE
Locally applied patches:
DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
DEBPKG:debian/db_file_ver - https://bugs.debian.org/340047 Remove overly restrictive DB_File version check.
DEBPKG:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.
DEBPKG:debian/enc2xs_inc - https://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @inc directories.
DEBPKG:debian/errno_ver - https://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
DEBPKG:debian/libperl_embed_doc - https://bugs.debian.org/186778 Note that libperl-dev package is required for embedded linking
DEBPKG:fixes/respect_umask - Respect umask during installation
DEBPKG:debian/writable_site_dirs - Set umask approproately for site install directories
DEBPKG:debian/extutils_set_libperl_path - EU:MM: set location of libperl.a under /usr/lib
DEBPKG:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor
DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.
DEBPKG:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.
DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.
DEBPKG:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.
DEBPKG:debian/perlivp - https://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
DEBPKG:debian/squelch-locale-warnings - https://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts
DEBPKG:debian/patchlevel - https://bugs.debian.org/567489 List packaged patches for 5.34.0-3ubuntu1.1 in patchlevel.h
DEBPKG:fixes/document_makemaker_ccflags - https://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags}
DEBPKG:debian/find_html2text - https://bugs.debian.org/640479 Configure CPAN::Distribution with correct name of html2text
DEBPKG:debian/perl5db-x-terminal-emulator.patch - https://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl
DEBPKG:debian/cpan-missing-site-dirs - https://bugs.debian.org/688842 Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent is writable
DEBPKG:fixes/memoize_storable_nstore - [rt.cpan.org #77790] https://bugs.debian.org/587650 Memoize::Storable: respect 'nstore' option not respected
DEBPKG:debian/makemaker-pasthru - https://bugs.debian.org/758471 Pass LD settings through to subdirectories
DEBPKG:debian/makemaker-manext - https://bugs.debian.org/247370 Make EU::MakeMaker honour MANnEXT settings in generated manpage headers
DEBPKG:debian/kfreebsd-softupdates - https://bugs.debian.org/796798 Work around Debian Bug#796798
DEBPKG:fixes/memoize-pod - [rt.cpan.org #89441] Fix POD errors in Memoize
DEBPKG:debian/hurd-softupdates - https://bugs.debian.org/822735 Fix t/op/stat.t failures on hurd
DEBPKG:fixes/math_complex_doc_great_circle - https://bugs.debian.org/697567 [rt.cpan.org #114104] Math::Trig: clarify definition of great_circle_midpoint
DEBPKG:fixes/math_complex_doc_see_also - https://bugs.debian.org/697568 [rt.cpan.org #114105] Math::Trig: add missing SEE ALSO
DEBPKG:fixes/math_complex_doc_angle_units - https://bugs.debian.org/731505 [rt.cpan.org #114106] Math::Trig: document angle units
DEBPKG:fixes/cpan_web_link - https://bugs.debian.org/367291 CPAN: Add link to main CPAN web site
DEBPKG:debian/hppa_op_optimize_workaround - https://bugs.debian.org/838613 Temporarily lower the optimization of op.c on hppa due to gcc-6 problems
DEBPKG:debian/installman-utf8 - https://bugs.debian.org/840211 Generate man pages with UTF-8 characters
DEBPKG:debian/hppa_opmini_optimize_workaround - https://bugs.debian.org/869122 Lower the optimization level of opmini.c on hppa
DEBPKG:debian/sh4_op_optimize_workaround - https://bugs.debian.org/869373 Also lower the optimization level of op.c and opmini.c on sh4
DEBPKG:debian/perldoc-pager - https://bugs.debian.org/870340 [rt.cpan.org #120229] Fix perldoc terminal escapes when sensible-pager is less
DEBPKG:debian/prune_libs - https://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
DEBPKG:debian/mod_paths - Tweak @inc ordering for Debian
DEBPKG:debian/deprecate-with-apt - https://bugs.debian.org/747628 Point users to Debian packages of deprecated core modules
DEBPKG:debian/disable-stack-check - https://bugs.debian.org/902779 [GH #16607] Disable debugperl stack extension checks for binary compatibility with perl
DEBPKG:debian/perlbug-editor - https://bugs.debian.org/922609 Use "editor" as the default perlbug editor, as per Debian policy
DEBPKG:debian/eu-mm-perl-base - https://bugs.debian.org/962138 Suppress an ExtUtils::MakeMaker warning about our non-default @inc
DEBPKG:fixes/io_socket_ip_ipv6 - Disable getaddrinfo(3) AI_ADDRCONFIG for localhost and IPv4 numeric addresses
DEBPKG:debian/usrmerge-lib64 - https://bugs.debian.org/914128 Configure / libpth.U: Do not adjust glibpth when /usr/lib64 is present.
DEBPKG:debian/usrmerge-realpath - https://bugs.debian.org/914128 Configure / libpth.U: use realpath --no-symlinks on Debian
DEBPKG:debian/configure-regen - https://bugs.debian.org/762638 Regenerate Configure et al. after probe unit changes
DEBPKG:fixes/x32-io-msg-skip - https://bugs.debian.org/922609 Skip io/msg.t on x32 due to broken System V message queues
DEBPKG:fixes/encode-CVE-2021-36770 - mitigate @inc pollution when loading ConfigLocal
DEBPKG:fixes/gdbm-1.20 - https://bugs.debian.org/993514 [GH #18915] Fix GDBM_File to compile with version 1.20 and earlier
DEBPKG:disable-libperl-tests -
DEBPKG:CVE-2020-16156-1.patch - [PATCH] bugfix: signature verification type CANNOT_VERIFY was not recognized
DEBPKG:CVE-2020-16156-2.patch - [PATCH] Add two new failure modes based on cpan_path
DEBPKG:CVE-2020-16156-3.patch - [PATCH] use gpg --verify --output ... to disentangle data and signature
DEBPKG:CVE-2020-16156-4.patch - [PATCH] replacing die with mydie in three spots
DEBPKG:CVE-2020-16156-5.patch - [PATCH] disambiguate the call to gpg --output by adding --verify
DEBPKG:CVE-2020-16156-6.patch - [PATCH] s/gpg/$gpg/ in system, add quotes where needed
DEBPKG:CVE-2020-16156-7.patch - [PATCH] s,/dev/null,$devnull,
Built under linux
Compiled at Oct 4 2022 18:16:23
%ENV:
PERLBREW="command perlbrew"
PERLBREW_HOME="/home/kes/.perlbrew"
PERLBREW_PATH="/home/kes/perl5/perlbrew/bin"
PERLBREW_ROOT="/home/kes/perl5/perlbrew"
PERLBREW_SHELLRC_VERSION="0.89"
PERLBREW_VERSION="0.89"
@inc:
/etc/perl
/usr/local/lib/x86_64-linux-gnu/perl/5.34.0
/usr/local/share/perl/5.34.0
/usr/lib/x86_64-linux-gnu/perl5/5.34
/usr/share/perl5
/usr/lib/x86_64-linux-gnu/perl-base
/usr/lib/x86_64-linux-gnu/perl/5.34
/usr/share/perl/5.34
/usr/local/lib/site_perl

PS. Is there a fold tag to hide perl -V?

[tonycoz]

PS. Is there a fold tag to hide perl -V?

<details><summary>short description</summary>
hidden content
</details>

If you use ``` inside this block you'll want some blank lines around it.

[tonycoz]

I think this might be a simpler reproducer:

tony@venus:.../git/perl6$ cat ../21102-try-this.pl
my $x = <<'EOS';
print "Hello\n";
BEGIN { $DB::single = 1; 1; }
sub foo {
print "Goodbye\n";
}
EOS

eval $x;
tony@venus:.../git/perl6$ ./perl -Ilib -d ../21102-try-this.pl

Loading DB routines from perl5db.pl version 1.77
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(../21102-try-this.pl:1): my $x = <<'EOS';
main::(../21102-try-this.pl:2): print "Hello\n";
main::(../21102-try-this.pl:3): BEGIN { $DB::single = 1; 1; }
main::(../21102-try-this.pl:4): sub foo {
main::(../21102-try-this.pl:5): print "Goodbye\n";
  DB<1> c
main::CODE(0x55d50357e318)((eval 9)[../21102-try-this.pl:9]:2):
2:      BEGIN { $DB::single = 1; 1; }
3:      sub foo {
4:      print "Goodbye\n";
  DB<1> T
@ = DB::DB called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = main::BEGIN() called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = eval {...} called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = eval 'print "Hello\\n";
BEGIN { $DB::single = 1; 1; }
sub foo {
print "Goodbye\\n";
}
' called from file '../21102-try-this.pl' line 9
  DB<1> 'asd
Can't find string terminator "'" anywhere before EOF at (eval 10)[lib/perl5db.pl:742] line 2.
 at (eval 10)[lib/perl5db.pl:742] line 2.
        eval '' called at lib/perl5db.pl line 742
        DB::eval called at lib/perl5db.pl line 3451
        DB::DB called at (eval 9)[../21102-try-this.pl:9] line 2
        main::BEGIN() called at (eval 9)[../21102-try-this.pl:9] line 2
        eval {...} called at (eval 9)[../21102-try-this.pl:9] line 2
        eval 'print "Hello\\n";
BEGIN { $DB::single = 1; 1; }
sub foo {
print "Goodbye\\n";
}
' called at ../21102-try-this.pl line 9

  DB<2> 

I could see it being very obnoxious in the debugger for a long eval, but it does appear to be deliberate from the code.

caller() itself appears to behave as documented, eg.

tony@venus:.../git/perl6$ ./perl -Ilib ../21102-db-caller.pl
main / (eval 2) / 9 / main::BEGIN / 1 /  /  /  / 256 /  / 
main / (eval 2) / 9 / (eval) / 0 /  /  /  / 256 /  / 
main / ../21102-db-caller.pl / 17 / (eval) / 0 /  / print "Hello\n";
BEGIN {
  package DB {
    my $x = 0;
    while (@x = caller($x++)) {
      print join(" / ", @x), "\n";
    }
  }
}
sub foo {
print "Goodbye\n";
}
 /  / 256 /  / 
main / (eval 1) / 1 / main::bar / 1 /  /  /  / 0 /  / 
main / ../21102-db-caller.pl / 20 / (eval) / 0 /  / bar() /  / 256 /  / 
Hello
tony@venus:.../git/perl6$ cat ../21102-db-caller.pl
my $x = <<'EOS';
print "Hello\n";
BEGIN {
  package DB {
    my $x = 0;
    while (@x = caller($x++)) {
      print join(" / ", @x), "\n";
    }
  }
}
sub foo {
print "Goodbye\n";
}
EOS

sub bar {
    eval $x;
}

eval 'bar()';

(eval) is from eval BLOCK, or from the eval context perl creates when evaluating a BEGIN block.

Note that the eval text isn't replacing the filename in the caller() result, for the perl debugger the debugger itself is replacing the sub name with eval 'evaltext', and I assume the same for whatever debugger you're using (I didn't see it on CPAN.)

So I don't see a bug (yet).

[KES777]

@tonycoz : I do not expect that the source will be used as name. In my case the source is around 20Kb.

*may you please fix formatting for your message. Thank you.

[tonycoz]

The message in your case, at least with the core debugger, is produced by Carp, and Carp lets you limit the length of the eval text:

$ ./perl -Ilib -d ../21102-try-this.pl

Loading DB routines from perl5db.pl version 1.77
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(../21102-try-this.pl:1): my $x = <<'EOS';
main::(../21102-try-this.pl:2): print "Hello\n";
main::(../21102-try-this.pl:3): BEGIN { $DB::single = 1; 1; }
main::(../21102-try-this.pl:4): sub foo {
main::(../21102-try-this.pl:5): print "Goodbye\n";
  DB<1> c
main::CODE(0x55b32c170d58)((eval 9)[../21102-try-this.pl:9]:2):
2:      BEGIN { $DB::single = 1; 1; }
3:      sub foo {
4:      print "Goodbye\n";
  DB<1> 'hello
Can't find string terminator "'" anywhere before EOF at (eval 10)[lib/perl5db.pl:742] line 2.
 at (eval 10)[lib/perl5db.pl:742] line 2.
        eval '' called at lib/perl5db.pl line 742
        DB::eval called at lib/perl5db.pl line 3451
        DB::DB called at (eval 9)[../21102-try-this.pl:9] line 2
        main::BEGIN() called at (eval 9)[../21102-try-this.pl:9] line 2
        eval {...} called at (eval 9)[../21102-try-this.pl:9] line 2
        eval 'print "Hello\\n";
BEGIN { $DB::single = 1; 1; }
sub foo {
print "Goodbye\\n";
}
' called at ../21102-try-this.pl line 9

  DB<2> $Carp::MaxEvalLen=25

  DB<3> 'hello
Can't find string terminator "'" anywhere before EOF at (eval 12)[lib/perl5db.pl:742] line 2.
 at (eval 12)[lib/perl5db.pl:742] line 2.
        eval '' called at lib/perl5db.pl line 742
        DB::eval called at lib/perl5db.pl line 3451
        DB::DB called at (eval 9)[../21102-try-this.pl:9] line 2
        main::BEGIN() called at (eval 9)[../21102-try-this.pl:9] line 2
        eval {...} called at (eval 9)[../21102-try-this.pl:9] line 2
        eval 'print "Hello\\n";
BEGI...' called at ../21102-try-this.pl line 9

  DB<4> 

You can control the length of the eval text from the T command with maxTraceLen:

  DB<4> T
@ = DB::DB called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = main::BEGIN() called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = eval {...} called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = eval 'print "Hello\\n";
BEGIN { $DB::single = 1; 1; }
sub foo {
print "Goodbye\\n";
}
' called from file '../21102-try-this.pl' line 9
  DB<4> o maxTraceLen=25
         maxTraceLen = '25'
  DB<5> T
@ = DB::DB called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = main::BEGIN() called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = eval {...} called from file '(eval 9)[../21102-try-this.pl:9]' line 2
. = eval 'print "Hello\\n"... called from file '../21102-try-this.pl' line 9
  DB<5> 

If you're using your own debugger (which you appear to be using), the formatting of the backtraces is entirely up to you or to the author of the debugger, if it isn't you.

[KES777]

I agree that output could be controlled. This is the issue of my debugger: it just dumps result from caller. But can you please explain me the reason why perl puts so long strings there?
Thank you very much.

[tonycoz]

I agree that output could be controlled. This is the issue of my debugger: it just dumps result from caller. But can you please explain me the reason why perl puts so long strings there? Thank you very much.

I'm not sure what's confusing here.

caller() in DB is documented to return the evaltext at index 6, perl5db.pl replaces the text returned at index 3 with that evaltext when the call frame is a string eval, from dump_trace() in perl5db.pl:

...
        and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i) ;
...
        # if the require flag is true, the eval text is from a require.
        if ($r) {
            $sub = "require '$e'";
        }

        # if it's false, the eval text is really from an eval.
        elsif ( defined $r ) {
            $sub = "eval '$e'";
        }

From get_subname() in Carp:

    if ( defined( $info->{evaltext} ) ) {
        my $eval = $info->{evaltext};
        if ( $info->{is_require} ) {
            return "require $eval";
        }
        else {
            $eval =~ s/([\\\'])/\\$1/g;
            return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
        }
    }

If you find that returning the evaltext instead of the file is obnoxious (and I can understand that for long evals) you can simply not do that, and just return the (eval), eg from the second example in my first response, one of the eval frames was:

main / ../21102-db-caller.pl / 20 / (eval) / 0 /  / bar() /  / 256 /  / 

where the perl5db.pl, Carp and apparently your debugger all replace the "(eval)" with variants on "bar()".

If you don't want that in your debugger then don't do that replacement.

[jkeenan]

Re-reading this ticket today, my impression is that @tonycoz has provided reasonable responses to the original poster's concerns. Hence, there's no action currently needed within the core distribution.

I am self-assigning it for the purpose of closing it within 7 days unless there is serious objection.

Thank you very much.