From 6e00a4556565aa46119d4ab858dc8ff3f1c03f99 Mon Sep 17 00:00:00 2001 From: Jitka Plesnikova Date: Tue, 16 May 2023 12:56:43 +0200 Subject: [PATCH] Upgrade to 2.188 --- Dumper.pm | 15 +++++++++++---- Dumper.xs | 25 +++++++++++++++++-------- Makefile.PL | 1 - t/dumper.t | 20 ++++++++++++++++++++ 4 files changed, 48 insertions(+), 13 deletions(-) diff --git a/Dumper.pm b/Dumper.pm index ba61ffe..bb6d3ca 100644 --- a/Dumper.pm +++ b/Dumper.pm @@ -18,6 +18,7 @@ use 5.008_001; require Exporter; use constant IS_PRE_516_PERL => $] < 5.016; +use constant SUPPORTS_CORE_BOOLS => defined &builtin::is_bool; use Carp (); @@ -29,7 +30,7 @@ our ( $Indent, $Trailingcomma, $Purity, $Pad, $Varname, $Useqq, $Terse, $Freezer our ( @ISA, @EXPORT, @EXPORT_OK, $VERSION ); BEGIN { - $VERSION = '2.184'; # Don't forget to set version and release + $VERSION = '2.188'; # Don't forget to set version and release # date in POD below! @ISA = qw(Exporter); @@ -551,6 +552,12 @@ sub _dump { elsif (!defined($val)) { $out .= "undef"; } + elsif (SUPPORTS_CORE_BOOLS && do { + BEGIN { SUPPORTS_CORE_BOOLS and warnings->unimport("experimental::builtin") } + builtin::is_bool($val) + }) { + $out .= $val ? '!!1' : '!!0'; + } # This calls the XSUB _vstring (if the XS code is loaded). I'm not *sure* if # if belongs in the "Pure Perl" implementation. It sort of depends on what # was meant by "Pure Perl", as this subroutine already relies Scalar::Util @@ -859,7 +866,7 @@ Data::Dumper - stringified perl data structures, suitable for both printing and } # OO usage - $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]); + my $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]); ... print $d->Dump; ... @@ -884,7 +891,7 @@ to substructures within C<$VAR>I will be appropriately labeled using arrow notation. You can specify names for individual values to be dumped if you use the C method, or you can change the default C<$VAR> prefix to something else. See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse> -below. +in L below. The default output of self-referential structures can be Ced, but the nested references to C<$VAR>I will be undefined, since a recursive @@ -1448,7 +1455,7 @@ modify it under the same terms as Perl itself. =head1 VERSION -Version 2.184 +Version 2.188 =head1 SEE ALSO diff --git a/Dumper.xs b/Dumper.xs index 8bd6397..4d54ba1 100644 --- a/Dumper.xs +++ b/Dumper.xs @@ -2,13 +2,11 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" -#ifdef USE_PPPORT_H -# define NEED_my_snprintf -# define NEED_my_sprintf -# define NEED_sv_2pv_flags -# define NEED_utf8_to_uvchr_buf -# include "ppport.h" -#endif +#define NEED_my_snprintf +#define NEED_my_sprintf +#define NEED_sv_2pv_flags +#define NEED_utf8_to_uvchr_buf +#include "ppport.h" #ifndef strlcpy # ifdef my_strlcpy @@ -1279,6 +1277,17 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, } } +#ifdef SvIsBOOL + if (SvIsBOOL(val)) { + if (SvTRUE(val)) { + sv_catpvs(retval, "!!1"); + } + else { + sv_catpvs(retval, "!!0"); + } + } + else +#endif if (DD_is_integer(val)) { STRLEN len; if (SvIsUV(val)) @@ -1315,7 +1324,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, SvCUR_set(retval, SvCUR(retval)+2); i = 3 + esc_q_utf8(aTHX_ retval, c, i, #ifdef GvNAMEUTF8 - !!GvNAMEUTF8(val), style->useqq + cBOOL(GvNAMEUTF8(val)), style->useqq #else 0, style->useqq || globname_supra_ascii(c, i) #endif diff --git a/Makefile.PL b/Makefile.PL index afbdba6..2920b46 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -18,6 +18,5 @@ WriteMakefile( VERSION_FROM => 'Dumper.pm', ABSTRACT_FROM => 'Dumper.pm', $] <= 5.011000 ? ( INSTALLDIRS => 'perl' ) : (), - ((grep { $_ eq 'PERL_CORE=1' } @ARGV) ? () : ('DEFINE' => '-DUSE_PPPORT_H')), @extra, ); diff --git a/t/dumper.t b/t/dumper.t index 80b2c8e..55a997c 100644 --- a/t/dumper.t +++ b/t/dumper.t @@ -1522,6 +1522,26 @@ EOT $want); } +############# +{ + if (!Data::Dumper::SUPPORTS_CORE_BOOLS) { + SKIP_BOTH("Core booleans not supported on older perls"); + last; + } + my $want = <<'EOT'; +#$VAR1 = [ +# !!1, +# !!0 +#]; +EOT + + $foo = [ !!1, !!0 ]; + TEST_BOTH(q(Data::Dumper::DumperX($foo)), + 'Booleans', + $want); +} + + ############# { # If XS cannot load, the pure-Perl version cannot deparse vstrings with -- 2.40.1