Permalink
Browse files

Core.pm: Don't trace into SelfLoader now that we know it works. selfl…

…oadertest.pl: this really works now. Add "set substitute command". SelfLoader.pm: protoype->prototype.
  • Loading branch information...
1 parent 911b244 commit 263c7bfce0fc528561d7331dad7cfa116e984ef6 Rocky Bernstein committed Jun 9, 2013
@@ -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";
+}
@@ -0,0 +1,44 @@
+# -*- coding: utf-8 -*-
+# Copyright (C) 2013 Rocky Bernstein <rocky@cpan.org>
+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;
@@ -0,0 +1,65 @@
+# -*- coding: utf-8 -*-
+# Copyright (C) 2013 Rocky Bernstein <rocky@cpan.org>
+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<set substitute path> [I<from-path>] I<to-path>
+
+Add a substitution rule replacing I<from-path> into I<to-path> in
+source file names. If a substitution rule was previously set for
+I<from-path>, the old rule is replaced by the new one. If I<from_path>
+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;
@@ -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;
@@ -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 {}

0 comments on commit 263c7bf

Please sign in to comment.