From 263c7bfce0fc528561d7331dad7cfa116e984ef6 Mon Sep 17 00:00:00 2001 From: Rocky Bernstein Date: Sat, 8 Jun 2013 23:39:28 -0400 Subject: [PATCH] Core.pm: Don't trace into SelfLoader now that we know it works. selfloadertest.pl: this really works now. Add "set substitute command". SelfLoader.pm: protoype->prototype. --- example/selfloadtest.pl | 8 ++- .../Command/Set_Subcmd/Substitute.pm | 44 +++++++++++++ .../Set_Subcmd/Substitute_Subcmd/Path.pm | 65 +++++++++++++++++++ lib/Devel/Trepan/Core.pm | 1 + lib/Devel/Trepan/DB/SelfLoader.pm | 30 +++++---- 5 files changed, 133 insertions(+), 15 deletions(-) create mode 100644 lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute.pm create mode 100644 lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute_Subcmd/Path.pm diff --git a/example/selfloadtest.pl b/example/selfloadtest.pl index 4fe95bc..5b127f5 100644 --- a/example/selfloadtest.pl +++ b/example/selfloadtest.pl @@ -1,12 +1,13 @@ #!/usr/bin/env perl use rlib '../lib'; -eval {use SelfLoader;}; +use SelfLoader; use strict; use warnings; package main; unless (caller()) { printf "%d\n", F_Undo(); + F_Also(); # print $Devel::Trepan::SelfLoader::Cache{'main::F_Undo'}; } @@ -19,3 +20,8 @@ sub F_Undo print "F_Undo called\n"; return $x + $y; } + +sub F_Also +{ + print "That's all!\n"; +} diff --git a/lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute.pm b/lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute.pm new file mode 100644 index 0000000..548c010 --- /dev/null +++ b/lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute.pm @@ -0,0 +1,44 @@ +# -*- coding: utf-8 -*- +# Copyright (C) 2013 Rocky Bernstein +use warnings; no warnings 'redefine'; no warnings 'once'; +use rlib '../../../../..'; +use strict; +use vars qw(@ISA @SUBCMD_VARS); + +package Devel::Trepan::CmdProcessor::Command::Set::Substitute; + +use Devel::Trepan::CmdProcessor::Command::Subcmd::Core; +use Devel::Trepan::CmdProcessor::Command::Subcmd::SubsubMgr; +use vars qw(@ISA @SUBCMD_VARS); +our $MIN_ABBREV = length('sub'); +our $HELP = <<"HELP"; +=pod + +Set filename remapping. + +Sometimes the filename or line ranges reported inside the debugger +might not match the filenames or line ranges where you can find the +source in the OS filesystem. This may happen because of pathnames do +not match or program text comes from evaluated lines in code. +=cut +HELP + +our $SHORT_HELP = "Set filename remapping"; + +@ISA = qw(Devel::Trepan::CmdProcessor::Command::SubsubcmdMgr); + +unless (caller) { + # Demo it. + require Devel::Trepan; + # require_relative '../../mock' + # dbgr, parent_cmd = MockDebugger::setup('set', false) + # cmd = Trepan::SubSubcommand::SetMax.new(dbgr.core.processor, + # parent_cmd) + # cmd.run(cmd.prefix + ['string', '30']) + + # %w(s lis foo).each do |prefix| + # p [prefix, cmd.complete(prefix)] + # end +} + +1; diff --git a/lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute_Subcmd/Path.pm b/lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute_Subcmd/Path.pm new file mode 100644 index 0000000..3a9a1d6 --- /dev/null +++ b/lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute_Subcmd/Path.pm @@ -0,0 +1,65 @@ +# -*- coding: utf-8 -*- +# Copyright (C) 2013 Rocky Bernstein +use warnings; no warnings 'redefine'; no warnings 'once'; +use rlib '../../../../../..'; + +package Devel::Trepan::CmdProcessor::Command::Set::Substitute::Path; +use Devel::Trepan::DB::LineCache; + +use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd; +use strict; +use vars qw(@ISA @SUBCMD_VARS); +@ISA = qw(Devel::Trepan::CmdProcessor::Command::Subsubcmd); + +# Values inherited from parent + +use vars @Devel::Trepan::CmdProcessor::Command::Subsubcmd::SUBCMD_VARS; +our $CMD = 'set display eval'; +my @DISPLAY_TYPES = @Devel::Trepan::CmdProcessor::DISPLAY_TYPES; +my $param = join('|', @DISPLAY_TYPES); +our $HELP = <<"HELP"; +=pod + +B [I] I + +Add a substitution rule replacing I into I in +source file names. If a substitution rule was previously set for +I, the old rule is replaced by the new one. If I +is not given use the current filename. + +=cut + +HELP + +our $MIN_ABBREV = length('pa'); +use constant MIN_ARGS => 1; +use constant MAX_ARGS => 2; +our $SHORT_HELP = 'Use PATH in place of a filename'; + +sub run($$) +{ + my ($self, $args) = @_; + my ($from_path, $to_path); + my $proc = $self->{proc}; + if (scalar(@$args) == 5) { + $from_path = $args->[3]; + $to_path = $args->[4]; + } else { + $from_path = $proc->{frame}{file}; + $to_path = $args->[3]; + } + # FIXME: Check from_path name to see if it is loaded + if (-f $to_path) { + remap_file($from_path, $to_path); + } else { + $proc->errmsg("File ${to_path} doesn't exist"); + } +} + +unless(caller) { + # requre File::Basename; + # Demo it. + # my $name = basename(__FILE__, '.pm') +} + +1; diff --git a/lib/Devel/Trepan/Core.pm b/lib/Devel/Trepan/Core.pm index 0fa9eaa..2205048 100644 --- a/lib/Devel/Trepan/Core.pm +++ b/lib/Devel/Trepan/Core.pm @@ -51,6 +51,7 @@ sub new { $self->awaken(); $self->skippkg('Devel::Trepan::Core'); $self->skippkg('Devel::Trepan::DB::Use'); + $self->skippkg('SelfLoader'); $self->register(); $self->ready(); return $self; diff --git a/lib/Devel/Trepan/DB/SelfLoader.pm b/lib/Devel/Trepan/DB/SelfLoader.pm index 7d03779..ce529a7 100644 --- a/lib/Devel/Trepan/DB/SelfLoader.pm +++ b/lib/Devel/Trepan/DB/SelfLoader.pm @@ -43,7 +43,7 @@ use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(AUTOLOAD); sub Version {$VERSION} -sub DEBUG () { 1 } +sub DEBUG () { 0 } our %Cache; # private cache for all SelfLoader's client packages @@ -91,7 +91,7 @@ sub _load_stubs { my $fh = \*{"${callpack}::DATA"}; use strict; my $currpack = $callpack; - my($line,$name,@lines, @stubs, $protoype); + my($line, $name, @lines, @stubs, $prototype); print STDERR "SelfLoader::load_stubs($callpack)\n" if DEBUG; croak("$callpack doesn't contain an __DATA__ token") @@ -109,8 +109,9 @@ sub _load_stubs { local($/) = "\n"; while(defined($line = <$fh>) and $line !~ m/^__END__/) { if ($line =~ m/^\s*sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$AttrList)?)/) { - push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); - $protoype = $2; + push(@stubs, + $self->_add_to_cache($name, $currpack, \@lines, $prototype)); + $prototype = $2; @lines = ($line); if (index($1,'::') == -1) { # simple sub name $name = "${currpack}::$1"; @@ -126,7 +127,8 @@ sub _load_stubs { } } } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared - push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); + push(@stubs, + $self->_add_to_cache($name, $currpack, \@lines, $prototype)); $self->_package_defined($line); $name = ''; @lines = (); @@ -153,22 +155,22 @@ sub _load_stubs { close($fh); } } - push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); + push(@stubs, + $self->_add_to_cache($name, $currpack, \@lines, $prototype)); no strict; eval join('', @stubs) if @stubs; } sub _add_to_cache { - my($self,$fullname,$pack,$lines, $protoype) = @_; - return () unless $fullname; - carp("Redefining sub $fullname") - if exists $Cache{$fullname}; - $Cache{$fullname} = join('', "\n\#line 1 \"sub $fullname\"\npackage $pack; ", @$lines); - #$Cache{$fullname} = join('', "package $pack; ",@$lines); - print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if DEBUG; + my($self, $funcname, $pack, $lines, $prototype) = @_; + return () unless $funcname; + carp("Redefining sub $funcname") if exists $Cache{$funcname}; + my $header = qq(\n\#line 1 "sub $funcname"\npackage $pack; ); + $Cache{$funcname} = join('', $header, @$lines); + print STDERR "SelfLoader cached $funcname: $Cache{$funcname}" if DEBUG; # return stub to be eval'd - defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;" + defined($prototype) ? "sub $funcname $prototype;" : "sub $funcname;" } sub _package_defined {}