diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 7cd081e54b..6406c88af2 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,9 @@ priorities and future plans. ## Work in progress +- Preserve Data::Dumper's pure-Perl numeric-string behavior for + Test::Differences, including copied `qw` values and numeric zero fixtures. + - Correct named-unary operand precedence, so `! scalar @array % 2` evaluates the modulo operation before its logical negation. diff --git a/src/main/perl/lib/Data/Dumper.pm b/src/main/perl/lib/Data/Dumper.pm index 361b8d2d6d..a100f5582a 100644 --- a/src/main/perl/lib/Data/Dumper.pm +++ b/src/main/perl/lib/Data/Dumper.pm @@ -580,7 +580,12 @@ sub _dump { $out .= sprintf "v%vd", $val; } # \d here would treat "1\x{660}" as a safe decimal number - elsif (defined &Data::Dumper::_perlonjava_numified_safe_decimal + # Test::Differences explicitly selects Data::Dumper's pure-Perl renderer. + # That renderer has always used the safe-decimal fallback below, which + # renders numeric-looking strings without quotes. Keep that behavior in + # Useperl mode; otherwise use PerlOnJava's scalar-aware hook so an + # untouched string remains distinguishable from a numeric scalar. + elsif ((!$s->{useperl} && defined &Data::Dumper::_perlonjava_numified_safe_decimal) ? Data::Dumper::_perlonjava_numified_safe_decimal($val) : $val =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { $out .= $val; diff --git a/src/test/resources/unit/scalar_dual_value_cpan_regressions.t b/src/test/resources/unit/scalar_dual_value_cpan_regressions.t new file mode 100644 index 0000000000..361e50c124 --- /dev/null +++ b/src/test/resources/unit/scalar_dual_value_cpan_regressions.t @@ -0,0 +1,79 @@ +use strict; +use warnings; +use Test::More; +use Data::Dumper; +use JSON::PP qw(decode_json); +use B (); + +sub eq_or_diff_via_data_dumper { + my ($got, $expected, $name) = @_; + + # Test::Differences enables this pure-Perl Data::Dumper configuration + # before comparing its serialized values. Keep the project unit test + # self-contained: Test::Differences is a CPAN test dependency and is not + # installed by the clean CI image. + local $Data::Dumper::Deparse = 1; + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Purity = 0; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Deepcopy = 1; + local $Data::Dumper::Quotekeys = 0; + local $Data::Dumper::Useperl = 1; + local $Data::Dumper::Sortkeys = 1; + + is(Dumper($got), Dumper($expected), $name); +} + +# Equivalent to List::PowerSet 0.01. Its recursive list copies must retain +# the scalar behavior Test::Differences observes with stock Perl. +sub powerset { + return [[]] if @_ == 0; + my $first = shift; + my $pow = powerset(@_); + return [ map { [$first, @$_], [@$_] } @$pow ]; +} + +eq_or_diff_via_data_dumper( + powerset(qw(1 2 3)), + [[1, 2, 3], [2, 3], [1, 3], [3], [1, 2], [2], [1], []], + 'recursive copies of numeric-looking qw values match numeric literals', +); + +# HTTP::BrowserDetect compares a computed numeric zero with a JSON string +# fixture through this same Data::Dumper-backed comparison path. +sub browser_major { return 0 } +my $browser_fixture = decode_json('{"browser_major":"0"}'); +eq_or_diff_via_data_dumper(browser_major(), $browser_fixture->{browser_major}, + 'method-returned numeric zero and JSON string zero compare through Test::Differences'); + +my $document = decode_json('{"number":1,"string":"1"}'); +my $number_flags = B::svref_2object(\$document->{number})->FLAGS; +my $string_flags = B::svref_2object(\$document->{string})->FLAGS; +ok($number_flags & (B::SVp_IOK() | B::SVp_NOK()), + 'JSON numeric token has numeric scalar flags'); +ok(!($number_flags & B::SVp_POK()), + 'JSON numeric token does not have string-only flags'); +ok($string_flags & B::SVp_POK(), + 'JSON string token has string flags'); +ok(!($string_flags & (B::SVp_IOK() | B::SVp_NOK())), + 'JSON string token does not gain numeric flags'); + +sub abs2rel { + return if !@_; + my @result = $_[0]; + for my $i (1 .. $#_) { + push @result, $_[$i] - $_[$i - 1]; + } + return @result; +} + +eq_or_diff_via_data_dumper( + [abs2rel(qw(1 2 3))], + [qw(1 1 1)], + 'arithmetic on string inputs preserves the comparison-visible string channel', +); + +local $Data::Dumper::Terse = 1; +is(Dumper('nonnumeric'), "'nonnumeric'\n", 'ordinary nonnumeric strings remain strings'); + +done_testing;