From 30b2d1faae0470c5e9330e0fa38b39d90c7f1cb6 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 21 May 2024 16:00:00 +1000
Subject: [PATCH] perl5db: distinguish an empty list or undef for w expressions

The debugger before the re-work around ~2012 discarded any list
value returned by the expression beyond the first element, but it
did distinguish an empty string from undef for that single value.

The re-work attempted to fix that by join()ing the elements returned
but this join was done before the filtering to distinguish undef
from an empty string, which resulted in watch expressions not
stopping on a change from undef to an empty string (or back).

So instead, filter each element returned by the watch expression for
undef before doing the join.
---
 lib/perl5db.pl |  6 ++----
 lib/perl5db.t  | 42 +++++++++++++++++++++++++++++++++++-------
 2 files changed, 37 insertions(+), 11 deletions(-)

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 3840a263c4..fbb909449f 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2475,8 +2475,7 @@ sub _DB__handle_watch_expressions
 
             # 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' );
+            my $val = join( ", ", map { defined ? "'$_'" : "undef" } DB::eval(@_) );
 
             # Did it change?
             if ( $val ne $DB::old_watch[$n] ) {
@@ -6102,8 +6101,7 @@ sub _add_watch_expr {
     # return a list value.
     $evalarg = $expr;
     # The &-call is here to ascertain the mutability of @_.
-    my ($val) = join( ' ', &DB::eval);
-    $val = ( defined $val ) ? "'$val'" : 'undef';
+    my $val = join( ", ", map { defined ? "'$_'" : "undef" } &DB::eval );
 
     # Save the current value of the expression.
     push @old_watch, $val;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index c2616f476b..ab35f993e0 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -1838,7 +1838,6 @@ DebugWrap->new({
             [
                 'n',
                 'w $foo',
-                'W $foo',
                 'c',
                 'print "\nIDX=<$idx>\n"',
                 'q',
@@ -1847,16 +1846,45 @@ DebugWrap->new({
         }
     );
 
-    $wrapper->contents_unlike(qr#
-        \$foo\ changed:
+
+    $wrapper->contents_like(qr#
+        \$foo\ changed:\n
+        \s+old\ value:\s+'1'\n
+        \s+new\ value:\s+'2'\n
         #msx,
-        'W command - watchpoint was deleted',
+        'w command - watchpoint changed',
+    );
+    $wrapper->output_like(qr#
+        \nIDX=<20>\n
+        #msx,
+        "w command - correct output from IDX",
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'w @foo',
+                'c',
+                'q',
+            ],
+            prog => \<<'PROG',
+my @foo;
+push @foo, undef;
+push @foo, "x";
+print @foo;
+PROG
+        }
     );
 
-    $wrapper->output_like(qr#
-        \nIDX=<>\n
+    $wrapper->contents_like(qr#
+        Watchpoint\ 0:\s+\@foo\ changed:\n
+        \s+old\ value:\s+\n
+        \s+new\ value:\s+undef\n
         #msx,
-        "W command - stopped at end.",
+        'w command - distinguish () from (undef)',
     );
 }