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.

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 7802f2b..379fb60 100644 (file)
--- 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 a5d4df4..fbf139c 100644 (file)
--- 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);
 }