From aab3a48238bd2132602bfa19158e90969dea844f 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 |  8 +++-----
 lib/perl5db.t  | 42 +++++++++++++++++++++++++++++++++++-------
 2 files changed, 38 insertions(+), 12 deletions(-)

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 9af8fe49a08c..1de232721704 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -532,7 +532,7 @@ BEGIN
 use vars qw($VERSION $header);
 
 # bump to X.XX in blead, only use X.XX_XX in maint
-$VERSION = '1.80';
+$VERSION = '1.81';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -2491,8 +2491,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] ) {
@@ -6061,8 +6060,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 8cbdcf155495..00b7eec62310 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=<>\n
+        \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->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)',
     );
 }