diff options
author | Shlomi Fish <shlomif@shlomifish.org> | 2012-12-09 23:58:38 +0200 |
---|---|---|
committer | Tony Cook <tony@develop-help.com> | 2013-01-02 11:22:10 +1100 |
commit | 5f5eab5267ab850c791997a0b8f9ea8f1bc9efcf (patch) | |
tree | ba66c5d58506b40036742944fee26b38bc07dfbf /lib | |
parent | 5c112a167449f8dcc084f78b7e689334e52311e6 (diff) | |
download | perl-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.pl | 66 | ||||
-rw-r--r-- | lib/perl5db.t | 30 |
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); } |