[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]

[perl #59626] [PATCH] Save code generated by references in @INC

From: Shawn M Moore (via RT) <perlbug-followup@perl.org>
Reply-To: perl5-porters@perl.org
To: bugs-bitbucket@netlabs.develooper.com
Date: Sat, 04 Oct 2008 15:15:37 -0700
Message-ID: <rt-3.6.HEAD-29759-1223158537-342.59626-75-0@perl.org>

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


Hi gang,

An obscure feature of Perl is that you can stick references in @INC to have
greater control over specialized loading of classes. We use this feature in
Jifty to provide virtual scaffolding (which prevents out-of-date stub files
from littering your project) and it's great!

Unfortunately, because Perl doesn't save the contents of these files, it's hard
for tools such as Devel::NYTProf to see the code and annotate it.

Attached (I hope) is a small patch (with a test) that makes sure the code
generated by references in @INC is saved in @{"_</path/to/filename"} as usual
(while the debugger is active, anyway). I cargo culted the code from
the eval STRING mechanism, so please speak up if there's something
amiss.

Thanks!
Shawn

-----------------------------------------------------------------
---
Flags:
    category=core
    severity=low
---
Site configuration information for perl 5.11.0:

Configured by sartak at Sat Oct  4 15:25:06 EDT 2008.

Summary of my perl5 (revision 5 version 11 subversion 0 patch 34456) configuration:
  Platform:
    osname=darwin, osvers=9.5.0, archname=darwin-2level
    uname='darwin onn.local 9.5.0 darwin kernel version 9.5.0: wed sep 3 11:29:43 pdt 2008; root:xnu-1228.7.58~1release_i386 i386 i386 '
    config_args=''
    hint=previous, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include',
    optimize='-O3',
    cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include'
    ccversion='', gccversion='4.0.1 (Apple Inc. build 5465)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    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, prototype=define
  Linker and Libraries:
    ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -fstack-protector -L/usr/local/lib -L/opt/local/lib'
    libpth=/usr/local/lib /opt/local/lib /usr/lib
    libs=-ldbm -ldl -lm -lutil -lc
    perllibs=-ldl -lm -lutil -lc
    libc=/usr/lib/libc.dylib, so=dylib, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib -L/opt/local/lib -fstack-protector'

Locally applied patches:
    DEVEL

---
@INC for perl 5.11.0:
    lib/
    /Users/sartak/.perl/lib
    lib/
    /Users/sartak/.perl/lib
    /home/sartak/app/bleadperl/lib/perl5/5.11.0/darwin-2level
    /home/sartak/app/bleadperl/lib/perl5/5.11.0
    /home/sartak/app/bleadperl/darwin-2level/
    /home/sartak/app/bleadperl/site_perl
    /home/sartak/.perl/blead/
    .

---
Environment for perl 5.11.0:
    DYLD_LIBRARY_PATH (unset)
    HOME=/Users/sartak
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LC_ALL=en_US.UTF-8
    LC_COLLATE=en_US.UTF-8
    LC_CTYPE=en_US.UTF-8
    LC_MESSAGES=en_US.UTF-8
    LC_MONETARY=en_US.UTF-8
    LC_NUMERIC=en_US.UTF-8
    LC_TIME=en_US.UTF-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/sartak/.bin:/opt/local/bin:/opt/local/sbin:/usr/games:/home/sartak/.bin:/opt/local/bin:/opt/local/sbin:/usr/games:/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/X11/bin
    PERL5LIB=lib/:/Users/sartak/.perl/lib:lib/:/Users/sartak/.perl/lib:
    PERL_BADLANG (unset)
    SHELL=/bin/zsh

diff -ruN bleadperl/pp_ctl.c bleadperl.new/pp_ctl.c
--- bleadperl/pp_ctl.c	2008-09-19 17:04:19.000000000 -0400
+++ bleadperl.new/pp_ctl.c	2008-10-04 17:51:40.000000000 -0400
@@ -3614,6 +3614,10 @@
     SAVECOPLINE(&PL_compiling);
     CopLINE_set(&PL_compiling, 0);
 
+    /* Save the code given by the reference in @INC */
+    if (hook_sv && PERLDB_LINE && PL_curstash != PL_debstash)
+        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
+
     PUTBACK;
 
     /* Store and reset encoding. */
diff -ruN bleadperl/t/run/switchd.t bleadperl.new/t/run/switchd.t
--- bleadperl/t/run/switchd.t	2008-09-19 17:04:21.000000000 -0400
+++ bleadperl.new/t/run/switchd.t	2008-10-04 17:38:13.000000000 -0400
@@ -9,7 +9,7 @@
 
 # This test depends on t/lib/Devel/switchd.pm.
 
-plan(tests => 2);
+plan(tests => 3);
 
 my $r;
 
@@ -44,3 +44,36 @@
     like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
 }
 
+# make sure that @{"_<file"} is populated in the debugger
+$filename = tempfile();
+SKIP: {
+	open my $f, ">$filename"
+	    or skip( "Can't write temp file $filename: $!" );
+	print $f <<'__SWDTEST__';
+push @INC, sub {
+    my ($self, $file) = @_;
+    print "Loading $file\n";
+    open my $fh, '<', \'
+our $VERSION = 1.0;
+1;
+';
+    return $fh;
+};
+
+require 'nonexistent-file.pm';
+
+my ($fullname) = grep { /nonexistent-file/ } grep { /^_</ } keys %main::;
+print "Got key: $fullname\n";
+print "$_: $fullname->[$_]" for 0 .. $#$fullname;
+
+__SWDTEST__
+    close $f;
+    $| = 1; # Unbufferize.
+    local $ENV{PERL5DB} = "sub DB::DB {}"; # Only here for other debugging hooks
+    $r = runperl(
+		 switches => [ '-Ilib', '-f', '-d' ],
+		 progfile => $filename,
+		);
+    like($r, qr{\ALoading nonexistent-file\.pm\nGot key: _</loader/0x\w+/nonexistent-file\.pm\n0: 1: \n2: our \$VERSION = 1.0;\n3: 1;\n\z});
+}
+

Follow-Ups from:: Nicholas Clark <nick@ccl4.org>

[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]