diff --git a/lib/Data/Printer.pm b/lib/Data/Printer.pm index 37f7a7b..b99015e 100644 --- a/lib/Data/Printer.pm +++ b/lib/Data/Printer.pm @@ -1064,8 +1064,9 @@ Damien Krotkine (dams), Denis Howe, dirk, Dotan Dimet, Eden Cardim (edenc), Elliot Shank (elliotjs), Eugen Konkov (KES777), Fernando Corrêa (SmokeMachine), Fitz Elliott, Florian (fschlich), Frew Schmidt (frew), GianniGi, Graham Knop (haarg), Graham Todd, Gregory J. Oschwald, grr, Håkon Hægland, -Iaroslav O. Kosmina (darviarush), Ivan Bessarabov (bessarabv), J Mash, -James E. Keenan (jkeenan), Jarrod Funnell (Timbus), Jay Allen (jayallen), +Hernan Lopes (hernan), Iaroslav O. Kosmina (darviarush), +Ivan Bessarabov (bessarabv), J Mash, James E. Keenan (jkeenan), +Jarrod Funnell (Timbus), Jay Allen (jayallen), Jay Hannah (jhannah), jcop, Jesse Luehrs (doy), Joel Berger (jberger), John S. Anderson (genehack), Karen Etheridge (ether), Kartik Thakore (kthakore), Kevin Dawson (bowtie), Kevin McGrath (catlgrep), diff --git a/lib/Data/Printer/Filter/SCALAR.pm b/lib/Data/Printer/Filter/SCALAR.pm index b96c5d4..57e38a3 100644 --- a/lib/Data/Printer/Filter/SCALAR.pm +++ b/lib/Data/Printer/Filter/SCALAR.pm @@ -3,6 +3,7 @@ use strict; use warnings; use Data::Printer::Filter; use Scalar::Util; +use B; filter 'SCALAR' => \&parse; filter 'LVALUE' => sub { @@ -26,7 +27,12 @@ sub parse { elsif ( $ddp->show_dualvar ne 'off' ) { my $numified; $numified = do { no warnings 'numeric'; 0+ $value } if defined $value; - if ( $numified ) { + if ( ( $numified || $numified == 0 ) && $ddp->show_numbers_strict eq 'on' && ! _is_number_strict( $value ) ) { + $ret = Data::Printer::Common::_process_string( $ddp, "$value", 'string' ); + $ret = _quoteme($ddp, $ret); + $ret .= ' (dualvar: ' . $ddp->maybe_colorize( $numified, 'number' ) . ')'; + } + elsif ( $numified ) { if ( "$numified" eq $value || ( # lax mode allows decimal zeroes @@ -122,4 +128,9 @@ sub _is_number { return $is_number; } +sub _is_number_strict { + my ($maybe_a_number) = @_; + return (0 != (B::svref_2object(\$maybe_a_number)->FLAGS & B::SVf_POK)) ? 0 : 1; +} + 1; diff --git a/lib/Data/Printer/Object.pm b/lib/Data/Printer/Object.pm index 581140f..d88cdc6 100644 --- a/lib/Data/Printer/Object.pm +++ b/lib/Data/Printer/Object.pm @@ -70,7 +70,7 @@ my @method_names =qw( hash_preserve unicode_charnames colored theme show_weak max_depth index separator end_separator class_method class hash_separator align_hash sort_keys quote_keys deparse return_value show_dualvar show_tied - warnings arrows coderef_stub coderef_undefined + warnings arrows coderef_stub coderef_undefined show_numbers_strict ); foreach my $method_name (@method_names) { no strict 'refs'; @@ -229,6 +229,13 @@ sub _init { $self->{caller_message} = $msg; } + $self->{'show_numbers_strict'} = Data::Printer::Common::_fetch_anyof( + $props, + 'show_numbers_strict', + 'off', + [qw(on off)] + ); + $self->multiline( Data::Printer::Common::_fetch_scalar_or_default($props, 'multiline', 1) ); @@ -897,7 +904,6 @@ or 'false'. If you have more than one of those in your data, Data::Printer will by default print the second one as a circular reference. When this option is set to true, it will instead resolve the scalar value and keep going. (default: false) - =head2 Array Options =head3 array_max @@ -923,8 +929,7 @@ or 'end'. (default: 'begin') When set, shows the index number before each array element. (default: 1) - -=head4 Hash Options +=head2 Hash Options =head3 align_hash diff --git a/t/002-scalar.t b/t/002-scalar.t index 6f1ab3f..0102b63 100644 --- a/t/002-scalar.t +++ b/t/002-scalar.t @@ -2,7 +2,7 @@ # ^^ taint mode must be on for taint checking. use strict; use warnings; -use Test::More tests => 67; +use Test::More tests => 85; use Data::Printer::Object; use Scalar::Util; @@ -17,6 +17,7 @@ test_readonly(); test_dualvar_lax(); test_dualvar_strict(); test_dualvar_off(); +test_numbers_strict(); sub test_weak_ref { my $num = 3.14; @@ -187,6 +188,55 @@ sub test_readonly { is $ddp->parse(\$foo), '42 (read-only)', 'readonly variables'; } +sub test_numbers_strict { + for my $t ( + [ "0", 'number', '"0" (dualvar: 0)' ], + [ 0, 'number' ], + [ '0.0', 'number', '"0.0" (dualvar: 0)' ], + [ '3', 'number', '"3" (dualvar: 3)' ], + [ 3, 'number' ], + [ '1.0', 'number', '"1.0" (dualvar: 1)'], + [ '1.10', 'number', '"1.10" (dualvar: 1.1)'], + [ 1.100, 'number'], + [ 1.000, 'number'], + [ '123 ', 'number', '"123 " (dualvar: 123)'], + [ '123.040 ', 'number', '"123.040 " (dualvar: 123.04)'], + [ ' 123', 'number', '" 123" (dualvar: 123)'], + [ ' 123.040', 'number', '" 123.040" (dualvar: 123.04)'], + [ + Scalar::Util::dualvar( 42, "The Answer" ), + 'dualvar', + '"The Answer" (dualvar: 42)' + ], + [ "Nil", 'string', '"Nil" (dualvar: 0)' ], + [ 0123, 'number' ], + [ "0199", 'dualvar', '"0199" (dualvar: 199)' ], + ) + { + my ( $var, $type, $expected ) = @$t; + my $ddp = Data::Printer::Object->new( colored => 0, show_numbers_strict => 'on' ); + is( + $ddp->parse( \$var ), + defined $expected ? $expected : "$var", + "$var in lax mode and show_numbers_strict is a $type" + ); + } + + # one very specific Perl dualvar + TODO: { + local $TODO; + if ($^O eq 'MSWin32') { + $TODO = q(Windows sometimes doesn't respect $! as a dualvar [lax]); + } + local $! = 2; + like( + Data::Printer::Object->new( colored => 0 )->parse( \$! ), + qr/".+" \(dualvar: 2\)/, + '$! is a dualvar' + ); + }; +} + sub test_dualvar_lax { # if you are adding tests here, please repeat them in test_dualvar_strict for my $t (