mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

perl5db: distinguish an empty list or undef for w expressions

Browse Source 
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.
This commit is contained in:
Tony Cook 2024-05-21 16:00:00 +10:00
parent 81a76be29e
commit 30b2d1faae
2 changed files with 37 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lib/perl5db.pl
View File

@ -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;

42
lib/perl5db.t
View File

@ -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)',
);
}