summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorShlomi Fish <shlomif@shlomifish.org>2012-12-09 23:58:38 +0200
committerTony Cook <tony@develop-help.com>2013-01-02 11:22:10 +1100
commit5f5eab5267ab850c791997a0b8f9ea8f1bc9efcf (patch)
treeba66c5d58506b40036742944fee26b38bc07dfbf /lib
parent5c112a167449f8dcc084f78b7e689334e52311e6 (diff)
downloadperl-5f5eab5267ab850c791997a0b8f9ea8f1bc9efcf.tar.gz
Fix perl -d's 'w $my_lexical_variable'.
This was done by reverting parts of the offending commit from the git bisecting and adding a test. Thanks to Kevin Dawson for the report.
Diffstat (limited to 'lib')
-rw-r--r--lib/perl5db.pl66
-rw-r--r--lib/perl5db.t30
2 files changed, 62 insertions, 34 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 7802f2baa9..379fb60a15 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2424,6 +2424,38 @@ sub _DB__at_end_of_every_command {
return;
}
+sub _DB__handle_watch_expressions
+{
+ my $self = shift;
+
+ if ( $DB::trace & 2 ) {
+ for my $n (0 .. $#DB::to_watch) {
+ $DB::evalarg = $DB::to_watch[$n];
+ local $DB::onetimeDump; # Tell DB::eval() to not output results
+
+ # Fix context DB::eval() wants to return an array, but
+ # we need a scalar here.
+ my ($val) = join( "', '", DB::eval(@_) );
+ $val = ( ( defined $val ) ? "'$val'" : 'undef' );
+
+ # Did it change?
+ if ( $val ne $DB::old_watch[$n] ) {
+
+ # Yep! Show the difference, and fake an interrupt.
+ $DB::signal = 1;
+ print {$DB::OUT} <<EOP;
+Watchpoint $n:\t$DB::to_watch[$n] changed:
+ old value:\t$DB::old_watch[$n]
+ new value:\t$val
+EOP
+ $DB::old_watch[$n] = $val;
+ } ## end if ($val ne $old_watch...
+ } ## end for my $n (0 ..
+ } ## end if ($trace & 2)
+
+ return;
+}
+
# 't' is type.
# 'm' is method.
# 'v' is the value (i.e: method name or subroutine ref).
@@ -2528,7 +2560,7 @@ sub DB {
my $was_signal = $signal;
# If we have any watch expressions ...
- $obj->_DB__handle_watch_expressions(@_);
+ _DB__handle_watch_expressions($obj);
=head2 C<watchfunction()>
@@ -3182,38 +3214,6 @@ sub _DB_on_init__initialize_globals
return;
}
-sub _DB__handle_watch_expressions
-{
- my $self = shift;
-
- if ( $trace & 2 ) {
- for my $n (0 .. $#to_watch) {
- $evalarg = $to_watch[$n];
- local $onetimeDump; # Tell DB::eval() to not output results
-
- # Fix context DB::eval() wants to return an array, but
- # we need a scalar here.
- my ($val) = join( "', '", DB::eval() );
- $val = ( ( defined $val ) ? "'$val'" : 'undef' );
-
- # Did it change?
- if ( $val ne $old_watch[$n] ) {
-
- # Yep! Show the difference, and fake an interrupt.
- $signal = 1;
- print {$OUT} <<EOP;
-Watchpoint $n:\t$to_watch[$n] changed:
- old value:\t$old_watch[$n]
- new value:\t$val
-EOP
- $old_watch[$n] = $val;
- } ## end if ($val ne $old_watch...
- } ## end for my $n (0 ..
- } ## end if ($trace & 2)
-
- return;
-}
-
sub _my_print_lineinfo
{
my ($self, $i, $incr_pos) = @_;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index a5d4df4abe..fbf139cca2 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
}
}
-plan(107);
+plan(108);
my $rc_filename = '.perldb';
@@ -2593,6 +2593,34 @@ sub _calc_trace_wrapper
);
}
+# Test the w for lexical variables expression.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ # This is to avoid getting the "Debugger program terminated"
+ # junk that interferes with the normal output.
+ 'w $exp',
+ 'n',
+ 'n',
+ 'n',
+ 'n',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/break-on-dot',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/
+\s+old\ value:\s+'1'\n
+\s+new\ value:\s+'2'\n
+ /msx,
+ "Test w for lexical values.",
+ );
+}
+
END {
1 while unlink ($rc_filename, $out_fn);
}