diff -Nru libsereal-perl-4.007/Changes libsereal-perl-4.011/Changes --- libsereal-perl-4.007/Changes 2019-04-09 17:01:20.000000000 +0000 +++ libsereal-perl-4.011/Changes 2020-02-04 04:49:05.000000000 +0000 @@ -13,6 +13,21 @@ * Sereal package and instead install the Encoder or * * Decoder independently. * **************************************************************** +4.011 Tues February 4, 2020 + * Fix and test custom opcode logic for 5.31.2 and later. + +4.010 Tues February 4, 2020 + * Encoder/Decoder: Update miniz + * Encoder/Decoder: Update zstd + * Sereal/Encoder/Decoder: perltidy perl code to a standard style + +4.009 Fri January 31, 2020 + * Encoder/Decoder: Update ppport.h for modern perls. + +4.008 Thurs Jan 30, 2020 + * Encoder/Decoder: Build fixes for modern perls. + * Encoder/Decoder: Pod fixes + 4.007 Tues Apr 9, 2019 * Sereal: restore write_sereal(), read_sereal() as aliases to write_sereal_file() and read_sereal_file(). Better tests for exported subs. Add SRL_UNCOMPRESSED, diff -Nru libsereal-perl-4.007/debian/changelog libsereal-perl-4.011/debian/changelog --- libsereal-perl-4.007/debian/changelog 2019-07-21 18:30:27.000000000 +0000 +++ libsereal-perl-4.011/debian/changelog 2020-02-05 18:07:26.000000000 +0000 @@ -1,3 +1,15 @@ +libsereal-perl (4.011-1) unstable; urgency=medium + + * Import upstream version 4.011. + * Update versioned (build) dependencies on libsereal-{de,en}coder-perl. + * Use substvars for runtime dependency versions. + * Update years of packaging copyright. + * Declare compliance with Debian Policy 4.5.0. + * Annotate test-only build dependencies with . + * debian/watch: use uscan version 4. + + -- gregor herrmann Wed, 05 Feb 2020 19:07:26 +0100 + libsereal-perl (4.007-1) unstable; urgency=medium * Team upload. diff -Nru libsereal-perl-4.007/debian/control libsereal-perl-4.011/debian/control --- libsereal-perl-4.007/debian/control 2019-07-21 18:30:27.000000000 +0000 +++ libsereal-perl-4.011/debian/control 2020-02-05 18:07:26.000000000 +0000 @@ -5,14 +5,14 @@ Testsuite: autopkgtest-pkg-perl Priority: optional Build-Depends: debhelper-compat (= 12) -Build-Depends-Indep: libscalar-list-utils-perl, - libsereal-decoder-perl (>= 4.007), - libsereal-encoder-perl (>= 4.007), - libtest-longstring-perl, - libtest-simple-perl, - libtest-warn-perl, +Build-Depends-Indep: libscalar-list-utils-perl , + libsereal-decoder-perl (>= 4.011) , + libsereal-encoder-perl (>= 4.011) , + libtest-longstring-perl , + libtest-simple-perl , + libtest-warn-perl , perl -Standards-Version: 4.4.0 +Standards-Version: 4.5.0 Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/libsereal-perl Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/libsereal-perl.git Homepage: https://metacpan.org/release/Sereal @@ -21,8 +21,8 @@ Architecture: all Depends: ${misc:Depends}, ${perl:Depends}, - libsereal-decoder-perl (>= 4.007), - libsereal-encoder-perl (>= 4.007) + libsereal-decoder-perl (>= ${source:Upstream-Version}), + libsereal-encoder-perl (>= ${source:Upstream-Version}) Description: fast, compact, powerful binary (de-)serialization module wrapper Sereal is an efficient, compact-output, binary and feature-rich serialization protocol. The Perl encoder is implemented as the Sereal::Encoder module, the diff -Nru libsereal-perl-4.007/debian/copyright libsereal-perl-4.011/debian/copyright --- libsereal-perl-4.007/debian/copyright 2019-07-21 18:30:27.000000000 +0000 +++ libsereal-perl-4.011/debian/copyright 2020-02-05 18:07:26.000000000 +0000 @@ -9,7 +9,7 @@ Comment: license information taken from META.{yml,json}/Makefile.PL Files: debian/* -Copyright: 2015-2018, gregor herrmann +Copyright: 2015-2020, gregor herrmann License: Artistic or GPL-1+ License: Artistic diff -Nru libsereal-perl-4.007/debian/source/lintian-overrides libsereal-perl-4.011/debian/source/lintian-overrides --- libsereal-perl-4.007/debian/source/lintian-overrides 1970-01-01 00:00:00.000000000 +0000 +++ libsereal-perl-4.011/debian/source/lintian-overrides 2020-02-05 18:07:26.000000000 +0000 @@ -0,0 +1,3 @@ +# We do this on purpose, the packages are released in lockstep, even from the same git repo. +libsereal-perl source: version-substvar-for-external-package libsereal-perl -> libsereal-decoder-perl +libsereal-perl source: version-substvar-for-external-package libsereal-perl -> libsereal-encoder-perl diff -Nru libsereal-perl-4.007/debian/watch libsereal-perl-4.011/debian/watch --- libsereal-perl-4.007/debian/watch 2019-07-21 18:30:27.000000000 +0000 +++ libsereal-perl-4.011/debian/watch 2020-02-05 18:07:26.000000000 +0000 @@ -1,2 +1,2 @@ -version=3 -https://metacpan.org/release/Sereal .*/Sereal-v?(\d[\d.-]*)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ +version=4 +https://metacpan.org/release/Sereal .*/Sereal-v?@ANY_VERSION@@ARCHIVE_EXT@$ diff -Nru libsereal-perl-4.007/inc/Sereal/BuildTools.pm libsereal-perl-4.011/inc/Sereal/BuildTools.pm --- libsereal-perl-4.007/inc/Sereal/BuildTools.pm 2018-01-23 20:18:12.000000000 +0000 +++ libsereal-perl-4.011/inc/Sereal/BuildTools.pm 2020-02-02 17:25:40.000000000 +0000 @@ -1,10 +1,10 @@ -package # -inc::Sereal::BuildTools; +package # + inc::Sereal::BuildTools; use strict; use warnings; use Config; -use constant OSNAME => $^O; +use constant OSNAME => $^O; my %bare_minimum_files= map { $_ => 1 } qw{ typemap @@ -24,170 +24,182 @@ }; sub link_files { - my $shared_dir = shift; - my $mode = shift || ""; - my $exclude_tests= $mode eq "without_tests"; - my $tests_only= $mode eq "tests_only"; - my $bare_minimum= $mode eq "bare_minimum"; - - # This fires from a git source tree only. - # Right now, all devs are on Linux. Feel free to make portable. - eval { - # overwrite by default - require File::Find; - require File::Path; - require File::Spec; - File::Find::find( - { no_chdir => 1, - wanted => sub { - my $f = $_; - s/^\Q$shared_dir\E\/?// or die $_; - return unless $_; - return if $exclude_tests && m#^/?t/#; - return if $tests_only && !m#^/?t/#; - return if $bare_minimum && !exists $bare_minimum_files{$_}; - - if (-d $f) { - File::Path::mkpath($_) - } - elsif (-f $f) { - return if $f =~ /(?:\.bak|\.sw[po]|~)$/; - my @d = File::Spec->splitdir($_); - my $fname = pop @d; - my $ref = join "/", ("..") x scalar(@d); - my $subd = join "/", @d; - chdir $subd if length($ref); - my $srcfname = join("/", grep length, $ref, $shared_dir, $subd, $fname); - if (OSNAME eq 'MSWin32') { - die "link($srcfname, $fname) failed: $!" - unless link($srcfname, $fname); #only NTFS implements it - } - else { - symlink($srcfname, $fname); - } - chdir($ref) if length($ref); - } - }, - }, $shared_dir - ); - 1 - } or warn $@; + my $shared_dir= shift; + my $mode= shift || ""; + my $exclude_tests= $mode eq "without_tests"; + my $tests_only= $mode eq "tests_only"; + my $bare_minimum= $mode eq "bare_minimum"; + + # This fires from a git source tree only. + # Right now, all devs are on Linux. Feel free to make portable. + eval { + # overwrite by default + require File::Find; + require File::Path; + require File::Spec; + File::Find::find( { + no_chdir => 1, + wanted => sub { + my $f= $_; + s/^\Q$shared_dir\E\/?// or die $_; + return unless $_; + return if $exclude_tests && m#^/?t/#; + return if $tests_only && !m#^/?t/#; + return if $bare_minimum && !exists $bare_minimum_files{$_}; + + if ( -d $f ) { + File::Path::mkpath($_); + } + elsif ( -f $f ) { + return if $f =~ /(?:\.bak|\.sw[po]|~)$/; + my @d= File::Spec->splitdir($_); + my $fname= pop @d; + my $ref= join "/", ("..") x scalar(@d); + my $subd= join "/", @d; + chdir $subd if length($ref); + my $srcfname= join( "/", grep length, $ref, $shared_dir, $subd, $fname ); + if ( OSNAME eq 'MSWin32' ) { + die "link($srcfname, $fname) failed: $!" + unless link( $srcfname, $fname ); #only NTFS implements it + } + else { + symlink( $srcfname, $fname ); + } + chdir($ref) if length($ref); + } + }, + }, + $shared_dir + ); + 1; + } or warn $@; } sub generate_constant_includes { + # no-op } # Prefer external csnappy and miniz libraries over the bundled ones. sub check_external_libraries { - my ($libs, $defines, $objects, $subdirs) = @_; - require Devel::CheckLib; + my ( $libs, $defines, $objects, $subdirs )= @_; + require Devel::CheckLib; - if ( - !$ENV{SEREAL_USE_BUNDLED_LIBS} && - !$ENV{SEREAL_USE_BUNDLED_CSNAPPY} && - Devel::CheckLib::check_lib( - lib => 'csnappy', - header => 'csnappy.h' - )) { - print "Using installed csnappy library\n"; - $$libs .= ' -lcsnappy'; - $$defines .= ' -DHAVE_CSNAPPY'; - } else { - print "Using bundled csnappy code\n"; - } - - if ( - !$ENV{SEREAL_USE_BUNDLED_LIBS} && - !$ENV{SEREAL_USE_BUNDLED_MINIZ} && - Devel::CheckLib::check_lib( - lib => 'miniz', - header => 'miniz.h' - )) { - print "Using installed miniz library\n"; - $$libs .= ' -lminiz'; - $$defines .= ' -DHAVE_MINIZ'; - } else { - print "Using bundled miniz code\n"; - $$objects .= ' miniz$(OBJ_EXT)'; - } - - if ( - !$ENV{SEREAL_USE_BUNDLED_LIBS} && - !$ENV{SEREAL_USE_BUNDLED_ZSTD} && - Devel::CheckLib::check_lib( - lib => 'zstd', - header => 'zstd.h' - )) { - print "Using installed zstd library\n"; - $$libs .= ' -lzstd'; - $$defines .= ' -DHAVE_ZSTD'; - } else { - print "Using bundled zstd code\n"; - push @{ $subdirs }, 'zstd'; - $$objects .= ' zstd/libzstd$(OBJ_EXT)'; - } + if ( + !$ENV{SEREAL_USE_BUNDLED_LIBS} + && !$ENV{SEREAL_USE_BUNDLED_CSNAPPY} + && Devel::CheckLib::check_lib( + lib => 'csnappy', + header => 'csnappy.h' + ) ) + { + print "Using installed csnappy library\n"; + $$libs .= ' -lcsnappy'; + $$defines .= ' -DHAVE_CSNAPPY'; + } + else { + print "Using bundled csnappy code\n"; + } + + if ( + !$ENV{SEREAL_USE_BUNDLED_LIBS} + && !$ENV{SEREAL_USE_BUNDLED_MINIZ} + && Devel::CheckLib::check_lib( + lib => 'miniz', + header => 'miniz.h' + ) ) + { + print "Using installed miniz library\n"; + $$libs .= ' -lminiz'; + $$defines .= ' -DHAVE_MINIZ'; + } + else { + print "Using bundled miniz code\n"; + $$objects .= ' miniz$(OBJ_EXT)'; + } + + if ( + !$ENV{SEREAL_USE_BUNDLED_LIBS} + && !$ENV{SEREAL_USE_BUNDLED_ZSTD} + && Devel::CheckLib::check_lib( + lib => 'zstd', + header => 'zstd.h' + ) ) + { + print "Using installed zstd library\n"; + $$libs .= ' -lzstd'; + $$defines .= ' -DHAVE_ZSTD'; + } + else { + print "Using bundled zstd code\n"; + push @{$subdirs}, 'zstd'; + $$objects .= ' zstd/libzstd$(OBJ_EXT)'; + } } sub build_defines { - my (@defs) = @_; + my (@defs)= @_; - my $defines = join(" ", map { "-D$_" . (defined $ENV{$_} ? "=$ENV{$_}" : '') } - grep { exists $ENV{$_} } - (qw(NOINLINE DEBUG MEMDEBUG NDEBUG), @defs)); + my $defines= join( + " ", map { "-D$_" . ( defined $ENV{$_} ? "=$ENV{$_}" : '' ) } + grep { exists $ENV{$_} } ( qw(NOINLINE DEBUG MEMDEBUG NDEBUG), @defs ) ); $defines .= " -DNDEBUG" unless $ENV{DEBUG}; - if ($Config{osname} eq 'hpux' && not $Config{gccversion}) { - # HP-UX cc does not support inline. - # Or rather, it does, but it depends on the compiler flags, - # assumedly -AC99 instead of -Ae would work. - # But we cannot change the compiler config too much from - # the one that was used to compile Perl, - # so we just fake the inline away. - $defines .= " -Dinline= "; + if ( $Config{osname} eq 'hpux' && not $Config{gccversion} ) { + + # HP-UX cc does not support inline. + # Or rather, it does, but it depends on the compiler flags, + # assumedly -AC99 instead of -Ae would work. + # But we cannot change the compiler config too much from + # the one that was used to compile Perl, + # so we just fake the inline away. + $defines .= " -Dinline= "; } return $defines; } sub build_optimize { - my $cc_flags = shift || {}; + my $cc_flags= shift || {}; - my $catch_violations = exists $cc_flags->{catch_violations} ? $cc_flags->{catch_violations} : 1; + my $catch_violations= exists $cc_flags->{catch_violations} ? $cc_flags->{catch_violations} : 1; my $OPTIMIZE; - my $clang = 0; - if ($Config{gccversion}) { - $OPTIMIZE = '-O3'; - if ($Config{gccversion} =~ /[Cc]lang/) { # clang. - $clang = 1; + my $clang= 0; + if ( $Config{gccversion} ) { + $OPTIMIZE= '-O3'; + if ( $Config{gccversion} =~ /[Cc]lang/ ) { # clang. + $clang= 1; } - my $gccversion = 0; + my $gccversion= 0; if ( $Config{gccversion} =~ /^(\d+\.\d+)/ ) { - $gccversion = $1; + $gccversion= $1; } - if ( $catch_violations && ($clang || $gccversion >= 4.3) ) { + if ( $catch_violations && ( $clang || $gccversion >= 4.3 ) ) { + # -Werror= introduced in GCC 4.3 # For trapping C++ // comments we would need -std=c89 (aka -ansi) # but that may be asking too much of different platforms. $OPTIMIZE .= ' -Werror=declaration-after-statement '; } - } elsif ($Config{osname} eq 'MSWin32') { - $OPTIMIZE = '-O2 -W4'; - } else { - $OPTIMIZE = $Config{optimize}; + } + elsif ( $Config{osname} eq 'MSWin32' ) { + $OPTIMIZE= '-O2 -W4'; + } + else { + $OPTIMIZE= $Config{optimize}; } - if ($ENV{DEBUG}) { + if ( $ENV{DEBUG} ) { $OPTIMIZE .= ' -g'; - if ($ENV{DEBUG} > 0 && $Config{gccversion}) { - $OPTIMIZE .= ' -Wextra' if $ENV{DEBUG} > 1; - $OPTIMIZE .= ' -pedantic' if $ENV{DEBUG} > 5; # not pretty - $OPTIMIZE .= ' -Weverything' if ($ENV{DEBUG} > 6 && $clang); # really not pretty + if ( $ENV{DEBUG} > 0 && $Config{gccversion} ) { + $OPTIMIZE .= ' -Wextra' if $ENV{DEBUG} > 1; + $OPTIMIZE .= ' -pedantic' if $ENV{DEBUG} > 5; # not pretty + $OPTIMIZE .= ' -Weverything' if ( $ENV{DEBUG} > 6 && $clang ); # really not pretty } } @@ -198,32 +210,34 @@ require ExtUtils::MakeMaker; #Original by Alexandr Ciornii, modified by Yves Orton - my %params=@_; - my $eumm_version=$ExtUtils::MakeMaker::VERSION; - $eumm_version=eval $eumm_version; + my %params= @_; + my $eumm_version= $ExtUtils::MakeMaker::VERSION; + $eumm_version= eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; - if ($params{TEST_REQUIRES} and $eumm_version < 6.6303) { - $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; + if ( $params{TEST_REQUIRES} and $eumm_version < 6.6303 ) { + $params{BUILD_REQUIRES}= + { %{ $params{BUILD_REQUIRES} || {} }, %{ $params{TEST_REQUIRES} } }; delete $params{TEST_REQUIRES}; } - if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { + if ( $params{BUILD_REQUIRES} and $eumm_version < 6.5503 ) { + #EUMM 6.5502 has problems with BUILD_REQUIRES - $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; + $params{PREREQ_PM}= { %{ $params{PREREQ_PM} || {} }, %{ $params{BUILD_REQUIRES} } }; delete $params{BUILD_REQUIRES}; } - if ($params{CONFIGURE_REQUIRES} and $eumm_version < 6.52) { - $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}}, %{$params{CONFIGURE_REQUIRES}} }; + if ( $params{CONFIGURE_REQUIRES} and $eumm_version < 6.52 ) { + $params{PREREQ_PM}= { %{ $params{PREREQ_PM} || {} }, %{ $params{CONFIGURE_REQUIRES} } }; delete $params{CONFIGURE_REQUIRES}; } delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; - delete $params{META_MERGE} if $eumm_version < 6.46; - delete $params{META_ADD} if $eumm_version < 6.46; - delete $params{LICENSE} if $eumm_version < 6.31; - delete $params{AUTHOR} if $] < 5.005; - delete $params{ABSTRACT_FROM} if $] < 5.005; - delete $params{BINARY_LOCATION} if $] < 5.005; - delete $params{OPTIMIZE} if $^O eq 'MSWin32'; + delete $params{META_MERGE} if $eumm_version < 6.46; + delete $params{META_ADD} if $eumm_version < 6.46; + delete $params{LICENSE} if $eumm_version < 6.31; + delete $params{AUTHOR} if $] < 5.005; + delete $params{ABSTRACT_FROM} if $] < 5.005; + delete $params{BINARY_LOCATION} if $] < 5.005; + delete $params{OPTIMIZE} if $^O eq 'MSWin32'; ExtUtils::MakeMaker::WriteMakefile(%params); } diff -Nru libsereal-perl-4.007/lib/Sereal.pm libsereal-perl-4.011/lib/Sereal.pm --- libsereal-perl-4.007/lib/Sereal.pm 2019-04-09 17:01:31.000000000 +0000 +++ libsereal-perl-4.011/lib/Sereal.pm 2020-02-04 04:49:18.000000000 +0000 @@ -2,9 +2,9 @@ use 5.008; use strict; use warnings; -our $VERSION = '4.007'; -our $XS_VERSION = $VERSION; $VERSION= eval $VERSION; -use Sereal::Encoder 4.007 qw( +our $VERSION= '4.011'; +our $XS_VERSION= $VERSION; $VERSION= eval $VERSION; +use Sereal::Encoder 4.011 qw( encode_sereal sereal_encode_with_object SRL_UNCOMPRESSED @@ -12,7 +12,7 @@ SRL_ZLIB SRL_ZSTD ); -use Sereal::Decoder 4.007 qw( +use Sereal::Decoder 4.011 qw( decode_sereal looks_like_sereal decode_sereal_with_header_data @@ -26,7 +26,7 @@ ); use Exporter 'import'; -our @EXPORT_OK = qw( +our @EXPORT_OK= qw( get_sereal_decoder get_sereal_encoder clear_sereal_object_cache @@ -57,14 +57,17 @@ SRL_ZLIB SRL_ZSTD ); -our %EXPORT_TAGS = (all => \@EXPORT_OK); +our %EXPORT_TAGS= ( all => \@EXPORT_OK ); + # export by default if run from command line -our @EXPORT = ((caller())[1] eq '-e' ? @EXPORT_OK : ()); +our @EXPORT= ( ( caller() )[1] eq '-e' ? @EXPORT_OK : () ); our %ENCODERS; our %DECODERS; -sub _key { join "\t", map { $_ => $_[0]->{$_} } sort keys %{$_[0]} } +sub _key { + join "\t", map { $_ => $_[0]->{$_} } sort keys %{ $_[0] }; +} sub clear_sereal_object_cache { my $count= keys(%DECODERS) + keys(%ENCODERS); @@ -75,29 +78,27 @@ sub get_sereal_encoder { my ($opts)= @_; - return $ENCODERS{_key($opts)} ||= Sereal::Encoder->new($opts); + return $ENCODERS{ _key($opts) } ||= Sereal::Encoder->new($opts); } sub get_sereal_decoder { my ($opts)= @_; - return $DECODERS{_key($opts)} ||= Sereal::Decoder->new($opts); + return $DECODERS{ _key($opts) } ||= Sereal::Decoder->new($opts); } sub write_sereal_file { - my ($file, $struct, $append, $opts)= @_; - get_sereal_encoder($opts)->encode_to_file($file, $_[1], $append); + my ( $file, $struct, $append, $opts )= @_; + get_sereal_encoder($opts)->encode_to_file( $file, $_[1], $append ); } sub read_sereal_file { - my ($file, $opts)= @_; - get_sereal_decoder($opts)->decode_from_file($file,@_ > 2 ? $_[2] : ()); + my ( $file, $opts )= @_; + get_sereal_decoder($opts)->decode_from_file( $file, @_ > 2 ? $_[2] : () ); } *read_sereal= *read_sereal= *read_sereal_file; *write_sereal= *write_sereal= *write_sereal_file; - - 1; __END__ diff -Nru libsereal-perl-4.007/Makefile.PL libsereal-perl-4.011/Makefile.PL --- libsereal-perl-4.007/Makefile.PL 2019-04-09 17:01:31.000000000 +0000 +++ libsereal-perl-4.011/Makefile.PL 2020-02-04 04:49:18.000000000 +0000 @@ -4,15 +4,11 @@ use ExtUtils::MakeMaker; use Cwd; -our $VERSION = '4.007'; +our $VERSION= '4.011'; -my $shared_dir = "../shared"; +my $shared_dir= "../shared"; my $its_our_repo_file= "../this_is_the_Sereal_repo.txt"; -my $in_source_repo =( -d "../../.git" - and -d $shared_dir - and -e "../this_is_the_Sereal_repo.txt" - ); - +my $in_source_repo= ( -d "../../.git" and -d $shared_dir and -e "../this_is_the_Sereal_repo.txt" ); unshift @INC, ".", "./inc"; unshift @INC, $shared_dir, "$shared_dir/inc" @@ -21,75 +17,77 @@ if ($in_source_repo) { eval "use blib '../Encoder/blib'; use blib '../Decoder/blib'; 1" or die "While building in Sereal.git, failed to use blib: $@\n", - "You probably need to run `make` in the Encoder and Decoder directories\n"; + "You probably need to run `make` in the Encoder and Decoder directories\n"; } -my $module = "Sereal"; +my $module= "Sereal"; require inc::Sereal::BuildTools; -inc::Sereal::BuildTools::link_files($shared_dir,"tests_only") if $in_source_repo; +inc::Sereal::BuildTools::link_files( $shared_dir, "tests_only" ) if $in_source_repo; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile1( MIN_PERL_VERSION => '5.008', - META_MERGE => { + META_MERGE => { resources => { repository => { - url => 'git://github.com/Sereal/Sereal.git', + url => 'git://github.com/Sereal/Sereal.git', }, bugtracker => { - web => 'https://github.com/Sereal/Sereal/issues', + web => 'https://github.com/Sereal/Sereal/issues', }, }, 'meta-spec' => { version => 2 }, }, TEST_REQUIRES => { - 'Test::More' => 0.88, - 'Sereal::Encoder' => $VERSION, - 'Sereal::Decoder' => $VERSION, - 'Scalar::Util' => 0, - 'File::Spec' => 0, + 'Test::More' => 0.88, + 'Sereal::Encoder' => $VERSION, + 'Sereal::Decoder' => $VERSION, + 'Scalar::Util' => 0, + 'File::Spec' => 0, 'Test::LongString' => '0', - 'Test::Warn' => '0', - 'Data::Dumper' => '0', + 'Test::Warn' => '0', + 'Data::Dumper' => '0', }, - NAME => 'Sereal', - VERSION_FROM => 'lib/Sereal.pm', # finds $VERSION - PREREQ_PM => { + NAME => 'Sereal', + VERSION_FROM => 'lib/Sereal.pm', # finds $VERSION + PREREQ_PM => { 'Sereal::Encoder' => $VERSION, 'Sereal::Decoder' => $VERSION, - }, # e.g., Module::Name => 1.1 - LICENSE => 'perl', + }, # e.g., Module::Name => 1.1 + LICENSE => 'perl', ABSTRACT_FROM => 'lib/Sereal.pm', - AUTHOR => 'Steffen Mueller ', - test => { + AUTHOR => 'Steffen Mueller , Yves Orton ', + test => { TESTS => "t/*.t t/*/*/*.t", }, ); -sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.20. Added by eumm-upgrade. - my %params=@_; - my $eumm_version=$ExtUtils::MakeMaker::VERSION; - $eumm_version=eval $eumm_version; +sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.20. Added by eumm-upgrade. + my %params= @_; + my $eumm_version= $ExtUtils::MakeMaker::VERSION; + $eumm_version= eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; - if ($params{TEST_REQUIRES} and $eumm_version < 6.6303) { - $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; + if ( $params{TEST_REQUIRES} and $eumm_version < 6.6303 ) { + $params{BUILD_REQUIRES}= + { %{ $params{BUILD_REQUIRES} || {} }, %{ $params{TEST_REQUIRES} } }; delete $params{TEST_REQUIRES}; } - if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { + if ( $params{BUILD_REQUIRES} and $eumm_version < 6.5503 ) { + #EUMM 6.5502 has problems with BUILD_REQUIRES - $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; + $params{PREREQ_PM}= { %{ $params{PREREQ_PM} || {} }, %{ $params{BUILD_REQUIRES} } }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; - delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; - delete $params{META_MERGE} if $eumm_version < 6.46; - delete $params{META_ADD} if $eumm_version < 6.46; - delete $params{LICENSE} if $eumm_version < 6.31; - delete $params{AUTHOR} if $] < 5.005; - delete $params{ABSTRACT_FROM} if $] < 5.005; - delete $params{BINARY_LOCATION} if $] < 5.005; + delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; + delete $params{META_MERGE} if $eumm_version < 6.46; + delete $params{META_ADD} if $eumm_version < 6.46; + delete $params{LICENSE} if $eumm_version < 6.31; + delete $params{AUTHOR} if $] < 5.005; + delete $params{ABSTRACT_FROM} if $] < 5.005; + delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } diff -Nru libsereal-perl-4.007/META.json libsereal-perl-4.011/META.json --- libsereal-perl-4.007/META.json 2019-04-09 17:06:02.000000000 +0000 +++ libsereal-perl-4.011/META.json 2020-02-04 05:00:05.000000000 +0000 @@ -1,16 +1,16 @@ { "abstract" : "Fast, compact, powerful binary (de-)serialization", "author" : [ - "Steffen Mueller " + "Steffen Mueller , Yves Orton " ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : "2" + "version" : 2 }, "name" : "Sereal", "no_index" : { @@ -32,8 +32,8 @@ }, "runtime" : { "requires" : { - "Sereal::Decoder" : "4.007", - "Sereal::Encoder" : "4.007", + "Sereal::Decoder" : "4.011", + "Sereal::Encoder" : "4.011", "perl" : "5.008" } }, @@ -42,8 +42,8 @@ "Data::Dumper" : "0", "File::Spec" : "0", "Scalar::Util" : "0", - "Sereal::Decoder" : "4.007", - "Sereal::Encoder" : "4.007", + "Sereal::Decoder" : "4.011", + "Sereal::Encoder" : "4.011", "Test::LongString" : "0", "Test::More" : "0.88", "Test::Warn" : "0" @@ -60,6 +60,6 @@ "url" : "git://github.com/Sereal/Sereal.git" } }, - "version" : "4.007", - "x_serialization_backend" : "JSON::PP version 2.27400_02" + "version" : "4.011", + "x_serialization_backend" : "JSON::PP version 4.04" } diff -Nru libsereal-perl-4.007/META.yml libsereal-perl-4.011/META.yml --- libsereal-perl-4.007/META.yml 2019-04-09 17:06:02.000000000 +0000 +++ libsereal-perl-4.011/META.yml 2020-02-04 05:00:05.000000000 +0000 @@ -1,21 +1,21 @@ --- abstract: 'Fast, compact, powerful binary (de-)serialization' author: - - 'Steffen Mueller ' + - 'Steffen Mueller , Yves Orton ' build_requires: Data::Dumper: '0' ExtUtils::MakeMaker: '0' File::Spec: '0' Scalar::Util: '0' - Sereal::Decoder: '4.007' - Sereal::Encoder: '4.007' + Sereal::Decoder: '4.011' + Sereal::Encoder: '4.011' Test::LongString: '0' Test::More: '0.88' Test::Warn: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -26,11 +26,11 @@ - t - inc requires: - Sereal::Decoder: '4.007' - Sereal::Encoder: '4.007' + Sereal::Decoder: '4.011' + Sereal::Encoder: '4.011' perl: '5.008' resources: bugtracker: https://github.com/Sereal/Sereal/issues repository: git://github.com/Sereal/Sereal.git -version: '4.007' +version: '4.011' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -Nru libsereal-perl-4.007/t/001_load.t libsereal-perl-4.011/t/001_load.t --- libsereal-perl-4.007/t/001_load.t 2017-10-03 17:46:07.000000000 +0000 +++ libsereal-perl-4.011/t/001_load.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; diff -Nru libsereal-perl-4.007/t/002_constants.t libsereal-perl-4.011/t/002_constants.t --- libsereal-perl-4.007/t/002_constants.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/002_constants.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -15,6 +16,6 @@ use Test::More tests => 2; -is(SRL_MAGIC_STRING, "=srl", "check magic string"); -is(SRL_HDR_UNDEF, 37, "check arbitrary header constant"); +is( SRL_MAGIC_STRING, "=srl", "check magic string" ); +is( SRL_HDR_UNDEF, 37, "check arbitrary header constant" ); diff -Nru libsereal-perl-4.007/t/002_export.t libsereal-perl-4.011/t/002_export.t --- libsereal-perl-4.007/t/002_export.t 2017-10-03 17:46:07.000000000 +0000 +++ libsereal-perl-4.011/t/002_export.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -11,12 +12,12 @@ use Sereal; use Test::More tests => 6; -ok(defined(\&Sereal::encode_sereal), 'encode_sereal defined in Sereal'); -ok(defined(\&Sereal::decode_sereal), 'decode_sereal defined in Sereal'); -ok(defined(\&Sereal::looks_like_sereal), 'looks_like_sereal defined in Sereal'); +ok( defined( \&Sereal::encode_sereal ), 'encode_sereal defined in Sereal' ); +ok( defined( \&Sereal::decode_sereal ), 'decode_sereal defined in Sereal' ); +ok( defined( \&Sereal::looks_like_sereal ), 'looks_like_sereal defined in Sereal' ); Sereal->import(':all'); -ok(defined(\&encode_sereal), 'encode_sereal defined in main'); -ok(defined(\&decode_sereal), 'decode_sereal defined in main'); -ok(defined(\&looks_like_sereal), 'looks_like_sereal defined in main'); +ok( defined( \&encode_sereal ), 'encode_sereal defined in main' ); +ok( defined( \&decode_sereal ), 'decode_sereal defined in main' ); +ok( defined( \&looks_like_sereal ), 'looks_like_sereal defined in main' ); diff -Nru libsereal-perl-4.007/t/002_have_enc_and_dec.t libsereal-perl-4.011/t/002_have_enc_and_dec.t --- libsereal-perl-4.007/t/002_have_enc_and_dec.t 2017-11-12 19:30:52.000000000 +0000 +++ libsereal-perl-4.011/t/002_have_enc_and_dec.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,15 +4,17 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; } use Sereal::TestSet qw(:all); -if (have_encoder_and_decoder()) { +if ( have_encoder_and_decoder() ) { plan tests => 1; -} else { +} +else { plan skip_all => 'Must have both encoder and decoder to run this test.'; } diag "Testing with both encoder and decoder."; diff -Nru libsereal-perl-4.007/t/003_basic.t libsereal-perl-4.011/t/003_basic.t --- libsereal-perl-4.007/t/003_basic.t 2019-04-08 19:33:25.000000000 +0000 +++ libsereal-perl-4.011/t/003_basic.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -11,8 +12,8 @@ use Sereal; use Test::More tests => 3; -my $s = Sereal::encode_sereal("foo"); -ok(defined $s); -ok(Sereal::looks_like_sereal($s)) or diag $s; -is(Sereal::decode_sereal($s), "foo"); +my $s= Sereal::encode_sereal("foo"); +ok( defined $s ); +ok( Sereal::looks_like_sereal($s) ) or diag $s; +is( Sereal::decode_sereal($s), "foo" ); diff -Nru libsereal-perl-4.007/t/003_ptable.t libsereal-perl-4.011/t/003_ptable.t --- libsereal-perl-4.007/t/003_ptable.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/003_ptable.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,13 +3,14 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; } use Sereal::TestSet; use Sereal::Encoder; -$| = 1; +$|= 1; print "1..40\n"; Sereal::Encoder::_ptabletest::test(); diff -Nru libsereal-perl-4.007/t/004_testset.t libsereal-perl-4.011/t/004_testset.t --- libsereal-perl-4.007/t/004_testset.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/004_testset.t 2020-02-02 17:25:40.000000000 +0000 @@ -7,6 +7,7 @@ # test our test framework use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -16,21 +17,21 @@ use Test::More; # needs more tests -ok(_deep_cmp(["x"],{})); -ok(_deep_cmp({"x"=>1},{"y"=>1})); -ok(_deep_cmp({"x"=>1},{"x"=>2})); -ok(_deep_cmp({"x"=>1},{"x"=>2,"y"=>1})); -ok(!_deep_cmp({"x"=>1},{"x"=>1})); -ok(!_deep_cmp(["x"],["x"])); -ok(_deep_cmp(["x"],["y","p"])); -ok(_deep_cmp(["a","x"],["y"])); -ok(_cmp_str("foo","bar")); -ok(!_cmp_str("aaa","aaa")); -ok(_cmp_str("aaacowbbb","aaadogbb")); +ok( _deep_cmp( ["x"], {} ) ); +ok( _deep_cmp( { "x" => 1 }, { "y" => 1 } ) ); +ok( _deep_cmp( { "x" => 1 }, { "x" => 2 } ) ); +ok( _deep_cmp( { "x" => 1 }, { "x" => 2, "y" => 1 } ) ); +ok( !_deep_cmp( { "x" => 1 }, { "x" => 1 } ) ); +ok( !_deep_cmp( ["x"], ["x"] ) ); +ok( _deep_cmp( ["x"], [ "y", "p" ] ) ); +ok( _deep_cmp( [ "a", "x" ], ["y"] ) ); +ok( _cmp_str( "foo", "bar" ) ); +ok( !_cmp_str( "aaa", "aaa" ) ); +ok( _cmp_str( "aaacowbbb", "aaadogbb" ) ); my $l= "ba\xDF"; my $u= $l; utf8::upgrade($u); -ok(_cmp_str($l,$u)); +ok( _cmp_str( $l, $u ) ); pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/005_flags.t libsereal-perl-4.011/t/005_flags.t --- libsereal-perl-4.007/t/005_flags.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/005_flags.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,24 +4,26 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; } use Sereal::TestSet qw(:all); -if (have_encoder_and_decoder(3.005003)) { - run_tests("plain", { } ); - run_tests( "no_shared_hk", { no_shared_hashkeys => 1 } ); - run_tests( "dedupe_strings", { dedupe_strings => 1 } ); +if ( have_encoder_and_decoder(3.005003) ) { + run_tests( "plain", {} ); + run_tests( "no_shared_hk", { no_shared_hashkeys => 1 } ); + run_tests( "dedupe_strings", { dedupe_strings => 1 } ); run_tests( "aliased_dedupe_strings", { aliased_dedupe_strings => 1 } ); done_testing(); -} else { +} +else { plan skip_all => "Did not find right version of encoder/decoder"; } sub run_tests { - my ( $extra_name, $opt_hash ) = @_; + my ( $extra_name, $opt_hash )= @_; my $encoder= Sereal::Encoder->new($opt_hash); my $decoder= Sereal::Decoder->new($opt_hash); @@ -31,55 +33,55 @@ # of the vars we are testing (in terms of SV flags), # which can break the tests. my %tests= (); - foreach my $str ("0","1","100","10.01",".01") { - foreach my $pfx (map { ($_, " $_") } "","0","-","-0") { - foreach my $sfx (map { ($_, "$_ ") } "","0") { - my $n="str num '$pfx$str$sfx'"; + foreach my $str ( "0", "1", "100", "10.01", ".01" ) { + foreach my $pfx ( map { ( $_, " $_" ) } "", "0", "-", "-0" ) { + foreach my $sfx ( map { ( $_, "$_ " ) } "", "0" ) { + my $n= "str num '$pfx$str$sfx'"; $tests{$n}= "$pfx$str$sfx"; } } } - $tests{"num: $_"}= $_ - for (map { (" $_", "$_ ", " $_ ") } (qw(0e0 3e3), "0 but true")); + $tests{"num: $_"}= $_ for ( map { ( " $_", "$_ ", " $_ " ) } ( qw(0e0 3e3), "0 but true" ) ); $tests{"false"}= !1; $tests{"true"}= !0; - foreach my $v (values %tests) { + foreach my $v ( values %tests ) { no warnings; my $i= int $v; my $f= $v + 0.5; my $s= "" . $v; } - foreach my $k (keys %tests) { + foreach my $k ( keys %tests ) { no warnings; $tests{"$k (PN)"}= "" . $tests{$k}; my $f= $tests{"$k (PN)"} + 0.5; $tests{"$k (PI)"}= "" . $tests{$k}; - my $i= int $tests{"$k (PI)"}; + my $i= int $tests{"$k (PI)"}; } $tests{"raw false"}= !1; $tests{"raw true"}= !0; - foreach my $test ( sort keys %tests ) { my $test_name= "$test - $extra_name"; - my $encoded= $encoder->encode($tests{$test}); + my $encoded= $encoder->encode( $tests{$test} ); my $decoded= $decoder->decode($encoded); TODO: { # we must do this test before we test numeric equivalence no warnings 'numeric'; - my $have= ($decoded ^ '1'); - my $want= ($tests{$test} ^ '1'); - local $TODO = $have ne $want ? "Cannot reliably round trip NIOK flag(s)" : undef; - is($have, $want, "$test_name - Xor string (\$var ^ '1')"); + my $have= ( $decoded ^ '1' ); + my $want= ( $tests{$test} ^ '1' ); + local $TODO= $have ne $want ? "Cannot reliably round trip NIOK flag(s)" : undef; + is( $have, $want, "$test_name - Xor string (\$var ^ '1')" ); } { no warnings 'numeric'; - ok( $decoded eq $tests{$test}, "$test_name - string equivalence"); + ok( $decoded eq $tests{$test}, "$test_name - string equivalence" ); + # this test MUST be last. - ok( $decoded == $tests{$test}, "$test_name - numeric equivalence"); + ok( $decoded == $tests{$test}, "$test_name - numeric equivalence" ); } + # hobodecode($expect); # hobodecode($out); } diff -Nru libsereal-perl-4.007/t/006_sereal_file.t libsereal-perl-4.011/t/006_sereal_file.t --- libsereal-perl-4.007/t/006_sereal_file.t 2019-04-09 17:01:20.000000000 +0000 +++ libsereal-perl-4.011/t/006_sereal_file.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -43,85 +44,100 @@ use Test::More tests => 30; use File::Temp; my $dir= File::Temp->newdir; -my $source= {foo=>1}; +my $source= { foo => 1 }; { my $file= "$dir/test1.srl"; { - write_sereal_file($file,$source); - ok(-e $file, "write_sereal_file: file exists"); + write_sereal_file( $file, $source ); + ok( -e $file, "write_sereal_file: file exists" ); } { my $copy= read_sereal_file($file); - is_deeply($source,$copy,"read_sereal_file: simple read works"); + is_deeply( $source, $copy, "read_sereal_file: simple read works" ); } { - read_sereal_file($file,{},my $copy); - is_deeply($source,$copy,"read_sereal_file: read to root works"); + read_sereal_file( $file, {}, my $copy ); + is_deeply( $source, $copy, "read_sereal_file: read to root works" ); } { - read_sereal_file($file,undef,my $copy); - is_deeply($source,$copy,"read_sereal_file: read to root works (undef opts)"); + read_sereal_file( $file, undef, my $copy ); + is_deeply( $source, $copy, "read_sereal_file: read to root works (undef opts)" ); } } { my $file= "$dir/test2.srl"; { - write_sereal($file,$source,{compress => SRL_ZLIB}); - ok(-e $file, "write_sereal: file exists"); + write_sereal( $file, $source, { compress => SRL_ZLIB } ); + ok( -e $file, "write_sereal: file exists" ); } { my $copy= read_sereal($file); - is_deeply($source,$copy,"read_sereal: simple read works"); + is_deeply( $source, $copy, "read_sereal: simple read works" ); } { - read_sereal($file,{},my $copy); - is_deeply($source,$copy,"read_sereal: read to root works"); + read_sereal( $file, {}, my $copy ); + is_deeply( $source, $copy, "read_sereal: read to root works" ); } { - read_sereal($file,undef,my $copy); - is_deeply($source,$copy,"read_sereal: read to root works (undef opts)"); + read_sereal( $file, undef, my $copy ); + is_deeply( $source, $copy, "read_sereal: read to root works (undef opts)" ); } } { - my $encoder_0= get_sereal_encoder({compress => SRL_ZLIB, compress_level => 9}); - my $decoder_0= get_sereal_decoder({set_read_only => 1, use_undef => 1}); - is(ref($encoder_0),"Sereal::Encoder","get_sereal_encoder returned an encoder"); - is(ref($decoder_0),"Sereal::Decoder","get_sereal_decoder returned a decoder"); + my $encoder_0= get_sereal_encoder( { compress => SRL_ZLIB, compress_level => 9 } ); + my $decoder_0= get_sereal_decoder( { set_read_only => 1, use_undef => 1 } ); + is( ref($encoder_0), "Sereal::Encoder", "get_sereal_encoder returned an encoder" ); + is( ref($decoder_0), "Sereal::Decoder", "get_sereal_decoder returned a decoder" ); my $encoder_1= get_sereal_encoder(); my $decoder_1= get_sereal_decoder(); - is(ref($encoder_1),"Sereal::Encoder","get_sereal_encoder returned an encoder"); - is(ref($decoder_1),"Sereal::Decoder","get_sereal_decoder returned a decoder"); - ok($encoder_0 != $encoder_1,"encoder_0 is different from encoder_1"); - ok($decoder_0 != $decoder_1,"decoder_0 is different from decoder_1"); - my $encoder_2= get_sereal_encoder({compress => SRL_ZLIB, compress_level => 9}); - my $decoder_2= get_sereal_decoder({set_read_only => 1, use_undef => 1}); - is(ref($encoder_2),"Sereal::Encoder","get_sereal_encoder returned an encoder"); - is(ref($decoder_2),"Sereal::Decoder","get_sereal_decoder returned a decoder"); - ok($encoder_0 == $encoder_2,"encoder_0 is same as encoder_2"); - ok($decoder_0 == $decoder_2,"decoder_0 is same as decoder_2"); - is(clear_sereal_object_cache(),4,"clear_sereal_object_cache returned the expected number of items"); + is( ref($encoder_1), "Sereal::Encoder", "get_sereal_encoder returned an encoder" ); + is( ref($decoder_1), "Sereal::Decoder", "get_sereal_decoder returned a decoder" ); + ok( $encoder_0 != $encoder_1, "encoder_0 is different from encoder_1" ); + ok( $decoder_0 != $decoder_1, "decoder_0 is different from decoder_1" ); + my $encoder_2= get_sereal_encoder( { compress => SRL_ZLIB, compress_level => 9 } ); + my $decoder_2= get_sereal_decoder( { set_read_only => 1, use_undef => 1 } ); + is( ref($encoder_2), "Sereal::Encoder", "get_sereal_encoder returned an encoder" ); + is( ref($decoder_2), "Sereal::Decoder", "get_sereal_decoder returned a decoder" ); + ok( $encoder_0 == $encoder_2, "encoder_0 is same as encoder_2" ); + ok( $decoder_0 == $decoder_2, "decoder_0 is same as decoder_2" ); + is( + clear_sereal_object_cache(), 4, + "clear_sereal_object_cache returned the expected number of items" + ); } { - my $encoded= encode_sereal(["foo"]); + my $encoded= encode_sereal( ["foo"] ); my $decoded= decode_sereal($encoded); - is($decoded->[0],"foo","encode_sereal/decode_sereal seem to work"); - is(looks_like_sereal($encoded),4, "functional looks_like_sereal() works as expected"); - is(Sereal::Decoder->new()->looks_like_sereal($encoded),4,"object method looks_like_sereal() works as expected"); - is(Sereal::Decoder->looks_like_sereal($encoded),4,"class method looks_like_sereal() works as expected"); - is(scalar_looks_like_sereal($encoded),4, "functional scalar_looks_like_sereal() works as expected"); + is( $decoded->[0], "foo", "encode_sereal/decode_sereal seem to work" ); + is( looks_like_sereal($encoded), 4, "functional looks_like_sereal() works as expected" ); + is( + Sereal::Decoder->new()->looks_like_sereal($encoded), 4, + "object method looks_like_sereal() works as expected" + ); + is( + Sereal::Decoder->looks_like_sereal($encoded), 4, + "class method looks_like_sereal() works as expected" + ); + is( + scalar_looks_like_sereal($encoded), 4, + "functional scalar_looks_like_sereal() works as expected" + ); my $eval_ok= eval q{ scalar_looks_like_sereal("foo",$encoded); 1; }; my $error= $eval_ok ? "" : $@; - is($eval_ok,undef,"scalar_looks_like_sereal should die with two args"); - like($error,qr/^Too many arguments for Sereal::Decoder::scalar_looks_like_sereal/,"error looks as expected"); + is( $eval_ok, undef, "scalar_looks_like_sereal should die with two args" ); + like( + $error, qr/^Too many arguments for Sereal::Decoder::scalar_looks_like_sereal/, + "error looks as expected" + ); } { - is(SRL_UNCOMPRESSED,0,"SRL_UNCOMPRESSED has expected value"); - is(SRL_SNAPPY,1,"SRL_SNAPPY has expected value"); - is(SRL_ZLIB,2,"SRL_ZLIB has expected value"); - is(SRL_ZSTD,3,"SRL_ZSTD has expected value"); + is( SRL_UNCOMPRESSED, 0, "SRL_UNCOMPRESSED has expected value" ); + is( SRL_SNAPPY, 1, "SRL_SNAPPY has expected value" ); + is( SRL_ZLIB, 2, "SRL_ZLIB has expected value" ); + is( SRL_ZSTD, 3, "SRL_ZSTD has expected value" ); } diff -Nru libsereal-perl-4.007/t/010_desperate.t libsereal-perl-4.011/t/010_desperate.t --- libsereal-perl-4.007/t/010_desperate.t 2018-01-23 20:18:12.000000000 +0000 +++ libsereal-perl-4.011/t/010_desperate.t 2020-02-02 17:25:40.000000000 +0000 @@ -1,13 +1,15 @@ #!perl use strict; use warnings; + # most be loaded before Sereal::TestSet use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { - lib->import('lib') - if !-d 't'; + lib->import('lib') + if !-d 't'; } use Sereal::TestSet qw(:all); @@ -15,7 +17,7 @@ use Sereal::Encoder qw(encode_sereal); use Sereal::Encoder::Constants qw(:all); -use Data::Dumper; # must be loaded AFTER the test set (bug in perl) +use Data::Dumper; # must be loaded AFTER the test set (bug in perl) # These tests are extraordinarily basic, badly-done and really just # for basic sanity testing during development. @@ -23,55 +25,60 @@ use Test::More; run_tests("plain"); -run_tests("no_shared_hk", {no_shared_hashkeys => 1}); -run_tests("dedupe_strings", {dedupe_strings => 1}); -run_tests("aliased_dedupe_strings", {aliased_dedupe_strings => 1}); +run_tests( "no_shared_hk", { no_shared_hashkeys => 1 } ); +run_tests( "dedupe_strings", { dedupe_strings => 1 } ); +run_tests( "aliased_dedupe_strings", { aliased_dedupe_strings => 1 } ); done_testing(); sub run_tests { - my ($extra_name, $opt_hash) = @_; - setup_tests(4); - foreach my $bt (@BasicTests) { - my (undef, $expect, $name, @alternate) = @$bt; - - $name="unnamed" if not defined $name; - #next unless $name=~/PAD/; - - for my $x ( $expect, @alternate ) { - $x = $x->($opt_hash) if ref($x) eq 'CODE'; - # add the header ... - $x = Header() . $x; - } + my ( $extra_name, $opt_hash )= @_; + setup_tests(4); + foreach my $bt (@BasicTests) { + my ( undef, $expect, $name, @alternate )= @$bt; + + $name= "unnamed" if not defined $name; + + #next unless $name=~/PAD/; - my $enc = Sereal::Encoder->new($opt_hash ? $opt_hash : ()); - my $out; - eval{ - $out= $enc->encode($bt->[0]); # must use bt here or we get a copy - 1; - } or die "Failed to encode: \n$@\n". Data::Dumper::Dumper($bt->[0]); - ok(defined $out, "($extra_name) defined: $name") - or next; - - my $alt= ""; - if ($out ne $expect) { - foreach my $accept (@alternate) { - if ($out eq $accept) { - $expect= $accept; - $alt= " - alternate"; - last; + for my $x ( $expect, @alternate ) { + $x= $x->($opt_hash) if ref($x) eq 'CODE'; + + # add the header ... + $x= Header() . $x; + } + + my $enc= Sereal::Encoder->new( $opt_hash ? $opt_hash : () ); + my $out; + eval { + $out= $enc->encode( $bt->[0] ); # must use bt here or we get a copy + 1; + } or die "Failed to encode: \n$@\n" . Data::Dumper::Dumper( $bt->[0] ); + ok( defined $out, "($extra_name) defined: $name" ) + or next; + + my $alt= ""; + if ( $out ne $expect ) { + foreach my $accept (@alternate) { + if ( $out eq $accept ) { + $expect= $accept; + $alt= " - alternate"; + last; + } } } + is( + Data::Dumper::qquote($out), Data::Dumper::qquote($expect), + "($extra_name) correct: $name" . $alt + ) + or do { + if ( $ENV{DEBUG_SEREAL} ) { + print STDERR "\nEXPECTED:\n"; + hobodecode($expect); + print STDERR "\nGOT:\n"; + hobodecode($out); + print STDERR "\n"; + } + }; } - is(Data::Dumper::qquote($out), Data::Dumper::qquote($expect), "($extra_name) correct: $name" . $alt) - or do { - if ($ENV{DEBUG_SEREAL}) { - print STDERR "\nEXPECTED:\n"; - hobodecode($expect); - print STDERR "\nGOT:\n"; - hobodecode($out); - print STDERR "\n"; - } - }; - } } diff -Nru libsereal-perl-4.007/t/011_aliased_dedupe.t libsereal-perl-4.011/t/011_aliased_dedupe.t --- libsereal-perl-4.007/t/011_aliased_dedupe.t 2018-01-23 20:18:12.000000000 +0000 +++ libsereal-perl-4.011/t/011_aliased_dedupe.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,30 +5,37 @@ use File::Spec; use Scalar::Util qw(refaddr reftype); use lib File::Spec->catdir(qw(t lib)); + BEGIN { - lib->import('lib') - if !-d 't'; + lib->import('lib') + if !-d 't'; } use Sereal::TestSet qw(:all); use Sereal::Encoder qw(encode_sereal); use Sereal::Encoder::Constants qw(:all); -use Data::Dumper; # must be loaded AFTER the test set (bug in perl) +use Data::Dumper; # must be loaded AFTER the test set (bug in perl) use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of decoder'; } else { - my $dup = "bad" x 100; - my $dup2 = "beef" x 100; - my $enc = Sereal::Encoder->new({aliased_dedupe_strings => 1}); - my $encoded = $enc->encode([$dup,"a",$dup2,"b",$dup,"c",$dup2,"d"]); - my $decoded = Sereal::Decoder::decode_sereal($encoded); - is($decoded->[0],$dup); - is($decoded->[2],$dup2); - is(refaddr(\$decoded->[0]),refaddr(\$decoded->[4]),"expected same reference for decoded->[0] and decoded->[2]"); - is(refaddr(\$decoded->[2]),refaddr(\$decoded->[6]),"expected same reference for decoded->[2] and decoded->[6]"); + my $dup= "bad" x 100; + my $dup2= "beef" x 100; + my $enc= Sereal::Encoder->new( { aliased_dedupe_strings => 1 } ); + my $encoded= $enc->encode( [ $dup, "a", $dup2, "b", $dup, "c", $dup2, "d" ] ); + my $decoded= Sereal::Decoder::decode_sereal($encoded); + is( $decoded->[0], $dup ); + is( $decoded->[2], $dup2 ); + is( + refaddr( \$decoded->[0] ), refaddr( \$decoded->[4] ), + "expected same reference for decoded->[0] and decoded->[2]" + ); + is( + refaddr( \$decoded->[2] ), refaddr( \$decoded->[6] ), + "expected same reference for decoded->[2] and decoded->[6]" + ); } done_testing(); diff -Nru libsereal-perl-4.007/t/020_incremental.t libsereal-perl-4.011/t/020_incremental.t --- libsereal-perl-4.007/t/020_incremental.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/020_incremental.t 2020-02-02 17:25:40.000000000 +0000 @@ -6,97 +6,108 @@ use Devel::Peek; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; } use Sereal::TestSet qw(:all); -use Test::More tests => 8 + (2*6) + ( 31 * 3 ); +use Test::More tests => 8 + ( 2 * 6 ) + ( 31 * 3 ); use Sereal::Decoder qw(decode_sereal); use Sereal::Decoder::Constants qw(:all); - # Simple test to see whether we can get the number of bytes consumed # and whether offset works SCOPE: { - my $d = Sereal::Decoder->new(); - my $data = SRL_MAGIC_STRING . chr(1).chr(0).chr(SRL_HDR_UNDEF); - ok(!defined($d->decode($data. "GARBAGE")), "can decode with appended garbage"); - is($d->bytes_consumed, length($data), "consumed right number of bytes"); - - ok(!defined($d->decode_with_offset($data, 0)), "can decode with zero offset"); - is($d->bytes_consumed, length($data), "consumed right number of bytes"); - - ok(!defined($d->decode_with_offset("GARBAGE" . $data, length("GARBAGE"))), "can decode with offset"); - is($d->bytes_consumed, length($data), "consumed right number of bytes"); - - ok(!defined($d->decode_with_offset("GARBAGE" . $data . "TRAILING", length("GARBAGE"))), "can decode with offset and trailing garbage"); - is($d->bytes_consumed, length($data), "consumed right number of bytes"); + my $d= Sereal::Decoder->new(); + my $data= SRL_MAGIC_STRING . chr(1) . chr(0) . chr(SRL_HDR_UNDEF); + ok( !defined( $d->decode( $data . "GARBAGE" ) ), "can decode with appended garbage" ); + is( $d->bytes_consumed, length($data), "consumed right number of bytes" ); + + ok( !defined( $d->decode_with_offset( $data, 0 ) ), "can decode with zero offset" ); + is( $d->bytes_consumed, length($data), "consumed right number of bytes" ); + + ok( + !defined( $d->decode_with_offset( "GARBAGE" . $data, length("GARBAGE") ) ), + "can decode with offset" + ); + is( $d->bytes_consumed, length($data), "consumed right number of bytes" ); + + ok( + !defined( $d->decode_with_offset( "GARBAGE" . $data . "TRAILING", length("GARBAGE") ) ), + "can decode with offset and trailing garbage" + ); + is( $d->bytes_consumed, length($data), "consumed right number of bytes" ); } SCOPE: { - my $d = Sereal::Decoder->new({incremental => 1}); - my $data = ''; - $data .= SRL_MAGIC_STRING . chr(1).chr(0).chr(SRL_HDR_POS | $_) for 1..5; - - for (1..5) { - my $out = $d->decode($data); - is("$out", "$_", "Incremental section no. $_ yields right output"); + my $d= Sereal::Decoder->new( { incremental => 1 } ); + my $data= ''; + $data .= SRL_MAGIC_STRING . chr(1) . chr(0) . chr( SRL_HDR_POS | $_ ) for 1 .. 5; + + for ( 1 .. 5 ) { + my $out= $d->decode($data); + is( "$out", "$_", "Incremental section no. $_ yields right output" ); } - is($data, '', "Data is gone after incremental parsing"); + is( $data, '', "Data is gone after incremental parsing" ); } SCOPE: { - my $d = Sereal::Decoder->new({incremental => 1}); - my $data = ''; - $data .= SRL_MAGIC_STRING . chr(1).chr(0).chr(SRL_HDR_POS | $_) for 1..5; + my $d= Sereal::Decoder->new( { incremental => 1 } ); + my $data= ''; + $data .= SRL_MAGIC_STRING . chr(1) . chr(0) . chr( SRL_HDR_POS | $_ ) for 1 .. 5; utf8::upgrade($data); - for (1..5) { - my $out = $d->decode($data); - is("$out", "$_", "Incremental section no. $_ yields right output utf8 mode"); + for ( 1 .. 5 ) { + my $out= $d->decode($data); + is( "$out", "$_", "Incremental section no. $_ yields right output utf8 mode" ); } - is($data, '', "Data is gone after incremental parsing utf8 mode"); + is( $data, '', "Data is gone after incremental parsing utf8 mode" ); } SKIP: { - my $have_enc = have_encoder_and_decoder(); - if (not $have_enc) { + my $have_enc= have_encoder_and_decoder(); + if ( not $have_enc ) { skip "Need encoder for chunk tests", 31 * 3; } else { require Sereal::Encoder; - Sereal::Encoder->import("encode_sereal", "SRL_ZLIB"); + Sereal::Encoder->import( "encode_sereal", "SRL_ZLIB" ); - for my $tuple ( [ raw => [] ], - [ snappy_incr => [ { snappy_incr => 1 } ] ], - [ zlib => [ { compress => SRL_ZLIB() } ] ] ) + for my $tuple ( + [ raw => [] ], + [ snappy_incr => [ { snappy_incr => 1 } ] ], + [ zlib => [ { compress => SRL_ZLIB() } ] ] ) { - my ($name, $opts)= @$tuple; + my ( $name, $opts )= @$tuple; my $data; - my $n = 30; - $data .= encode_sereal($_, @$opts) for 1 .. $n; - my $decoder = Sereal::Decoder->new; + my $n= 30; + $data .= encode_sereal( $_, @$opts ) for 1 .. $n; + my $decoder= Sereal::Decoder->new; my @out; - my $pos = 0; - my $ok = eval { + my $pos= 0; + my $ok= eval { while (1) { - push @out, $decoder->decode_with_offset($data, $pos); + push @out, $decoder->decode_with_offset( $data, $pos ); $pos += $decoder->bytes_consumed; - last if $pos >= length($data) - or not $decoder->bytes_consumed; + last + if $pos >= length($data) + or not $decoder->bytes_consumed; } - 1 + 1; }; - my $err = $@ || 'Zombie error'; - ok($ok, "incremental decoder ($name) had no hissy fit") - or note("Error: $err. Data structures decoded up to that point:\n" . Data::Dumper::Dumper(\@out)); - - is($out[$_-1], $_, "Decoding multiple packets from single string works ($name: $_)") - for 1..$n; + my $err= $@ || 'Zombie error'; + ok( $ok, "incremental decoder ($name) had no hissy fit" ) + or note( "Error: $err. Data structures decoded up to that point:\n" + . Data::Dumper::Dumper( \@out ) ); + + is( + $out[ $_ - 1 ], $_, + "Decoding multiple packets from single string works ($name: $_)" + ) for 1 .. $n; } } } diff -Nru libsereal-perl-4.007/t/020_sort_keys.t libsereal-perl-4.011/t/020_sort_keys.t --- libsereal-perl-4.007/t/020_sort_keys.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/020_sort_keys.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,8 +14,8 @@ use Test::More; BEGIN { - eval "use Hash::Util 'num_buckets'; 1" or - eval "sub num_buckets(\\%) { (split( m!/!, scalar %{\$_[0]}))[-1] } 1" + eval "use Hash::Util 'num_buckets'; 1" + or eval "sub num_buckets(\\%) { (split( m!/!, scalar %{\$_[0]}))[-1] } 1" or die "Failed to set up num_buckets: $@"; } @@ -27,18 +28,18 @@ my $max= 15; my %hash; -my (%i, %j); -keys %i = $max; -keys %j = $max; +my ( %i, %j ); +keys %i= $max; +keys %j= $max; LOOP: -for my $x ("A" .. "Z") { - for my $y ( chr(ord($x)+1) .. "Z" ) { +for my $x ( "A" .. "Z" ) { + for my $y ( chr( ord($x) + 1 ) .. "Z" ) { %i= (); %j= (); $i{$x}= 1; $i{$y}= 1; $j{$y}= 1; $j{$x}= 1; - if ("@{[keys %i]}" ne "@{[keys %j]}") { # collission? + if ( "@{[keys %i]}" ne "@{[keys %j]}" ) { # collission? $hash{$x}= 1; last LOOP if keys %hash == $max; $hash{$y}= 1; @@ -51,8 +52,7 @@ my $copy_keys= join "", keys %copy; my %bigger= %hash; -keys(%bigger)= $max++ - while num_buckets(%bigger) eq num_buckets(%hash); +keys(%bigger)= $max++ while num_buckets(%bigger) eq num_buckets(%hash); my %shuffled; $shuffled{$_}= $hash{$_} for shuffle keys %hash; @@ -61,23 +61,30 @@ my %encoded_unsorted; for ( \%hash, \%copy, \%bigger, \%shuffled ) { my $keys= join "", keys %$_; - $encoded{$keys} ||= encode_sereal($_, { sort_keys => 1 } ); + $encoded{$keys} ||= encode_sereal( $_, { sort_keys => 1 } ); $encoded_unsorted{$keys} ||= encode_sereal($_); } my @keys= keys %encoded; if ( @keys > 1 ) { - plan tests => 2 * ( (@keys * (@keys-1)) / 2 ); -} else { + plan tests => 2 * ( ( @keys * ( @keys - 1 ) ) / 2 ); +} +else { plan skip_all => "Could not generate test hashes"; } foreach my $x ( 0 .. $#keys ) { - foreach my $y ($x + 1 .. $#keys) { - is($encoded{$keys[$x]}, $encoded{$keys[$y]},"$keys[$x] vs $keys[$y] (same: sort_keys)"); + foreach my $y ( $x + 1 .. $#keys ) { + is( + $encoded{ $keys[$x] }, $encoded{ $keys[$y] }, + "$keys[$x] vs $keys[$y] (same: sort_keys)" + ); SKIP: { skip "test causes random false failures", 1; - isnt($encoded_unsorted{$keys[$x]}, $encoded_unsorted{$keys[$y]},"$keys[$x] vs $keys[$y] (different: no sort_keys)"); + isnt( + $encoded_unsorted{ $keys[$x] }, $encoded_unsorted{ $keys[$y] }, + "$keys[$x] vs $keys[$y] (different: no sort_keys)" + ); } } } diff -Nru libsereal-perl-4.007/t/021_sort_keys_option.t libsereal-perl-4.011/t/021_sort_keys_option.t --- libsereal-perl-4.007/t/021_sort_keys_option.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/021_sort_keys_option.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use Test::More tests => 1; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -11,7 +12,6 @@ use Sereal::TestSet; use Sereal::Encoder qw(encode_sereal); -eval { encode_sereal(\1, { sort_keys => 1, stringify_unknown => 1 }); }; +eval { encode_sereal( \1, { sort_keys => 1, stringify_unknown => 1 } ); }; ok !$@, "We shouldn't die on sort_keys combined with stringify_unknown"; - diff -Nru libsereal-perl-4.007/t/022_canonical_refs.t libsereal-perl-4.011/t/022_canonical_refs.t --- libsereal-perl-4.007/t/022_canonical_refs.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/022_canonical_refs.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -12,17 +13,23 @@ use Test::More tests => 2; { - my $v = [{}]; - my $v_sereal = encode_sereal($v); - my $v2 = [@$v]; - my $v_new_sereal = encode_sereal($v); - cmp_ok($v_sereal, 'ne', $v_new_sereal, "Without canonical_refs we're sensitive to refcount changes"); + my $v= [ {} ]; + my $v_sereal= encode_sereal($v); + my $v2= [@$v]; + my $v_new_sereal= encode_sereal($v); + cmp_ok( + $v_sereal, 'ne', $v_new_sereal, + "Without canonical_refs we're sensitive to refcount changes" + ); } { - my $v = [{}]; - my $v_sereal = encode_sereal($v, {canonical_refs => 1}); - my $v2 = [@$v]; - my $v_new_sereal = encode_sereal($v, {canonical_refs => 1}); - cmp_ok($v_sereal, 'eq', $v_new_sereal, "With canonical_refs we're not sensitive to refcount changes"); + my $v= [ {} ]; + my $v_sereal= encode_sereal( $v, { canonical_refs => 1 } ); + my $v2= [@$v]; + my $v_new_sereal= encode_sereal( $v, { canonical_refs => 1 } ); + cmp_ok( + $v_sereal, 'eq', $v_new_sereal, + "With canonical_refs we're not sensitive to refcount changes" + ); } diff -Nru libsereal-perl-4.007/t/030_canonical_vs_test_deep.t libsereal-perl-4.011/t/030_canonical_vs_test_deep.t --- libsereal-perl-4.007/t/030_canonical_vs_test_deep.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/030_canonical_vs_test_deep.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -11,7 +12,8 @@ use Test::More; use Sereal::Encoder qw(encode_sereal); use version; -my %tests = ( +my %tests= ( + # IMPORTANT: If you add new types of cases here please update the # "CANONICAL REPRESENTATION" documentation. utf8_flag_on_ascii_string => [ @@ -19,7 +21,7 @@ return "en"; }, sub { - my $en = "en"; + my $en= "en"; utf8::upgrade($en); return $en; }, @@ -36,23 +38,31 @@ eval { require Test::Deep::NoTest; - die "PANIC: We expect at least Test::Deep 0.110 (and Test::Deep::NoTest doesn't support ->VERSION(...)" - unless version->new(Test::Deep->VERSION) >= version->new('0.110'); + die + "PANIC: We expect at least Test::Deep 0.110 (and Test::Deep::NoTest doesn't support ->VERSION(...)" + unless version->new( Test::Deep->VERSION ) >= version->new('0.110'); 1; } or do { - my $error = $@ || "Zombie Error"; - plan skip_all => "We are skipping all our tests because we don't have a suitable Test::Deep here, got error: $error"; + my $error= $@ || "Zombie Error"; + plan skip_all => + "We are skipping all our tests because we don't have a suitable Test::Deep here, got error: $error"; }; plan tests => keys(%tests) * 2; -for my $test (keys %tests) { - my ($x, $y) = @{$tests{$test}}; - my $x_value = $x->(); - my $y_value = $y->(); +for my $test ( keys %tests ) { + my ( $x, $y )= @{ $tests{$test} }; + my $x_value= $x->(); + my $y_value= $y->(); - my $x_value_sereal = encode_sereal($x_value, {canonical => 1}); - my $y_value_sereal = encode_sereal($y_value, {canonical => 1}); + my $x_value_sereal= encode_sereal( $x_value, { canonical => 1 } ); + my $y_value_sereal= encode_sereal( $y_value, { canonical => 1 } ); - cmp_ok($x_value_sereal, 'ne', $y_value_sereal, "The $test values are not the same under Sereal"); - ok(Test::Deep::eq_deeply($x_value, $y_value), "The $test values are the same under Test::Deep though"); + cmp_ok( + $x_value_sereal, 'ne', $y_value_sereal, + "The $test values are not the same under Sereal" + ); + ok( + Test::Deep::eq_deeply( $x_value, $y_value ), + "The $test values are the same under Test::Deep though" + ); } diff -Nru libsereal-perl-4.007/t/030_looks_like_sereal.t libsereal-perl-4.011/t/030_looks_like_sereal.t --- libsereal-perl-4.007/t/030_looks_like_sereal.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/030_looks_like_sereal.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -16,62 +17,65 @@ use Sereal::Decoder qw(decode_sereal looks_like_sereal scalar_looks_like_sereal); use Sereal::Decoder::Constants qw(:all); - sub doc { - my ($high, $version, $good)= @_; + my ( $high, $version, $good )= @_; - return( - ($high eq "utf8" ? SRL_MAGIC_STRING_HIGHBIT_UTF8 : - $high ? SRL_MAGIC_STRING_HIGHBIT : SRL_MAGIC_STRING) . - chr($version) . - chr(0) . - ($good ? chr(SRL_HDR_UNDEF) : "") - ); + return ( ( + $high eq "utf8" ? SRL_MAGIC_STRING_HIGHBIT_UTF8 + : $high ? SRL_MAGIC_STRING_HIGHBIT + : SRL_MAGIC_STRING + ) + . chr($version) + . chr(0) + . ( $good ? chr(SRL_HDR_UNDEF) : "" ) ); } - # Simple tests for looks_like_sereal. -my @tests = ( +my @tests= ( + # input, bool outcome, name - [ "", "", "empty string is not Sereal"], - [ undef, "", "undef string is not Sereal"], - [ {}, "", "{} is not Sereal"], - [ [], "", "[] is not Sereal"], - - [ SRL_MAGIC_STRING, "", "SRL_MAGIC_STRING alone is not Sereal"], - [ doc(0, 0, 1), "", "SRL_MAGIC_STRING with bad protocol is not Sereal"], - [ doc(0, 1, 0), "", "SRL_MAGIC_STRING protocol 1 with short body is not Sereal"], - [ doc(0, 1, 1), 1, "SRL_MAGIC_STRING protocol 1 with small payload is Sereal"], - [ doc(0, 2, 0), "", "SRL_MAGIC_STRING protocol 2 with short body is not Sereal"], - [ doc(0, 2, 1), 2, "SRL_MAGIC_STRING protocol 2 with small payload is Sereal"], - [ doc(0, 3, 0), "", "SRL_MAGIC_STRING protocol 3 with short body is not Sereal"], - [ doc(0, 3, 1), "", "SRL_MAGIC_STRING protocol 3 with small payload is Sereal"], - - [SRL_MAGIC_STRING_HIGHBIT, "", "SRL_MAGIC_STRING_HIGHBIT alone is not Sereal"], - [ doc( 1, 0, 1), "", "SRL_MAGIC_STRING_HIGHBIT with bad protocol is not Sereal"], - [ doc( 1, 1, 0), "", "SRL_MAGIC_STRING_HIGHBIT protocol 1 with short body is not Sereal"], - [ doc( 1, 1, 1), "", "SRL_MAGIC_STRING_HIGHBIT protocol 1 with small payload is not Sereal"], - [ doc( 1, 2, 0), "", "SRL_MAGIC_STRING_HIGHBIT protocol 2 with short body is not Sereal"], - [ doc( 1, 2, 1), "", "SRL_MAGIC_STRING_HIGHBIT protocol 2 with small payload is not Sereal"], - [ doc( 1, 3, 0), "", "SRL_MAGIC_STRING_HIGHBIT protocol 3 with short body is not Sereal"], - [ doc( 1, 3, 1), 3, "SRL_MAGIC_STRING_HIGHBIT protocol 3 with small payload is Sereal"], - [ doc("utf8", 3, 1), 0, "SRL_MAGIC_STRING_HIGHBIT_UTF8 protocol 3 with small payload is identified as utf8"], + [ "", "", "empty string is not Sereal" ], + [ undef, "", "undef string is not Sereal" ], + [ {}, "", "{} is not Sereal" ], + [ [], "", "[] is not Sereal" ], + + [ SRL_MAGIC_STRING, "", "SRL_MAGIC_STRING alone is not Sereal" ], + [ doc( 0, 0, 1 ), "", "SRL_MAGIC_STRING with bad protocol is not Sereal" ], + [ doc( 0, 1, 0 ), "", "SRL_MAGIC_STRING protocol 1 with short body is not Sereal" ], + [ doc( 0, 1, 1 ), 1, "SRL_MAGIC_STRING protocol 1 with small payload is Sereal" ], + [ doc( 0, 2, 0 ), "", "SRL_MAGIC_STRING protocol 2 with short body is not Sereal" ], + [ doc( 0, 2, 1 ), 2, "SRL_MAGIC_STRING protocol 2 with small payload is Sereal" ], + [ doc( 0, 3, 0 ), "", "SRL_MAGIC_STRING protocol 3 with short body is not Sereal" ], + [ doc( 0, 3, 1 ), "", "SRL_MAGIC_STRING protocol 3 with small payload is Sereal" ], + + [ SRL_MAGIC_STRING_HIGHBIT, "", "SRL_MAGIC_STRING_HIGHBIT alone is not Sereal" ], + [ doc( 1, 0, 1 ), "", "SRL_MAGIC_STRING_HIGHBIT with bad protocol is not Sereal" ], + [ doc( 1, 1, 0 ), "", "SRL_MAGIC_STRING_HIGHBIT protocol 1 with short body is not Sereal" ], + [ doc( 1, 1, 1 ), "", "SRL_MAGIC_STRING_HIGHBIT protocol 1 with small payload is not Sereal" ], + [ doc( 1, 2, 0 ), "", "SRL_MAGIC_STRING_HIGHBIT protocol 2 with short body is not Sereal" ], + [ doc( 1, 2, 1 ), "", "SRL_MAGIC_STRING_HIGHBIT protocol 2 with small payload is not Sereal" ], + [ doc( 1, 3, 0 ), "", "SRL_MAGIC_STRING_HIGHBIT protocol 3 with short body is not Sereal" ], + [ doc( 1, 3, 1 ), 3, "SRL_MAGIC_STRING_HIGHBIT protocol 3 with small payload is Sereal" ], + [ + doc( "utf8", 3, 1 ), 0, + "SRL_MAGIC_STRING_HIGHBIT_UTF8 protocol 3 with small payload is identified as utf8" + ], - ["=Srl". chr(1) . chr(0) . chr(SRL_HDR_UNDEF), "", "wrong magic string is not Sereal"], + [ "=Srl" . chr(1) . chr(0) . chr(SRL_HDR_UNDEF), "", "wrong magic string is not Sereal" ], ); plan tests => 2 + @tests * 5; -is(prototype(\&looks_like_sereal), undef); -is(prototype(\&scalar_looks_like_sereal), "\$"); +is( prototype( \&looks_like_sereal ), undef ); +is( prototype( \&scalar_looks_like_sereal ), "\$" ); -my $decoder = Sereal::Decoder->new; +my $decoder= Sereal::Decoder->new; foreach my $t (@tests) { - my ($input, $outcome, $name) = @$t; - is( scalar_looks_like_sereal($input), $outcome, "$name (new function oppable)" ); - is( &scalar_looks_like_sereal($input), $outcome, "$name (new function non-oppable)" ); - is( looks_like_sereal($input), $outcome, "$name (old function)" ); - is( $decoder->looks_like_sereal($input), $outcome, "$name (object method)" ); + my ( $input, $outcome, $name )= @$t; + is( scalar_looks_like_sereal($input), $outcome, "$name (new function oppable)" ); + is( &scalar_looks_like_sereal($input), $outcome, "$name (new function non-oppable)" ); + is( looks_like_sereal($input), $outcome, "$name (old function)" ); + is( $decoder->looks_like_sereal($input), $outcome, "$name (object method)" ); is( Sereal::Decoder->looks_like_sereal($input), $outcome, "$name (class method)" ); } diff -Nru libsereal-perl-4.007/t/040_special_vars.t libsereal-perl-4.011/t/040_special_vars.t --- libsereal-perl-4.007/t/040_special_vars.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/040_special_vars.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,45 +3,49 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; } use Sereal::TestSet qw(:all); -if (have_encoder_and_decoder(3.005003)) { +if ( have_encoder_and_decoder(3.005003) ) { plan tests => 6; -} else { +} +else { plan skip_all => 'Did not find right version of encoder'; } -my $enc = Sereal::Encoder->new; -my $dec = Sereal::Decoder->new; +my $enc= Sereal::Encoder->new; +my $dec= Sereal::Decoder->new; sub desc_special($) { - return $_[0] == \undef() ? "undef" : - $_[0] == \!1 ? "false" : - $_[0] == \!0 ? "true" : - !defined($_[0]) ? "undef" : - length($_[0]) ? "not-special" : - do { - my @warn; - local $SIG{__WARN__}= sub { push @warn,$_[0] }; - my $i= int($_[0]); - @warn ? "not-special" : "false"; - }; + return + $_[0] == \undef() ? "undef" + : $_[0] == \!1 ? "false" + : $_[0] == \!0 ? "true" + : !defined( $_[0] ) ? "undef" + : length( $_[0] ) ? "not-special" + : do { + my @warn; + local $SIG{__WARN__}= sub { push @warn, $_[0] }; + my $i= int( $_[0] ); + @warn ? "not-special" : "false"; + }; } -foreach( - [ "ref undef", \undef(), ], - [ "ref undef var", \do { my $z = undef }, ], - [ "ref false", \!1, ], - [ "ref false var", \do { my $z = !1 }, ], - [ "ref true", \!0, ], - [ "ref true var ", \do { my $z = !0 }, ], -) { - my ($name, $var, $todo)= @$_; +foreach ( + [ "ref undef", \undef(), ], + [ "ref undef var", \do { my $z= undef }, ], + [ "ref false", \!1, ], + [ "ref false var", \do { my $z= !1 }, ], + [ "ref true", \!0, ], + [ "ref true var ", \do { my $z= !0 }, ], + ) +{ + my ( $name, $var, $todo )= @$_; TODO: { todo_skip $todo, 1 if $todo; - is( desc_special($dec->decode($enc->encode($var))), desc_special($var), $name ); + is( desc_special( $dec->decode( $enc->encode($var) ) ), desc_special($var), $name ); } } diff -Nru libsereal-perl-4.007/t/040_tied_hash.t libsereal-perl-4.011/t/040_tied_hash.t --- libsereal-perl-4.007/t/040_tied_hash.t 2017-11-12 20:37:09.000000000 +0000 +++ libsereal-perl-4.011/t/040_tied_hash.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,12 +3,13 @@ package NewStdHash; require Tie::Hash; -our @ISA = qw(Tie::StdHash); +our @ISA= qw(Tie::StdHash); package main; use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -29,43 +30,43 @@ ); my $have_decoder= have_encoder_and_decoder(); if ($have_decoder) { - plan tests => 1 + (4 * @keys); -} else { + plan tests => 1 + ( 4 * @keys ); +} +else { plan tests => 1; } -my $enc = Sereal::Encoder->new({ +my $enc= Sereal::Encoder->new( { sort_keys => 1, -}); +} ); tie my %new_std_hash, 'NewStdHash'; my %normal_hash; -foreach my $i (0..$#keys) { - $new_std_hash{$keys[$i]} = $i; - $normal_hash{$keys[$i]}= $i; +foreach my $i ( 0 .. $#keys ) { + $new_std_hash{ $keys[$i] }= $i; + $normal_hash{ $keys[$i] }= $i; } -my $enc_tied = $enc->encode(\%new_std_hash); -my $enc_normal= $enc->encode(\%normal_hash); - +my $enc_tied= $enc->encode( \%new_std_hash ); +my $enc_normal= $enc->encode( \%normal_hash ); -is($enc_tied, $enc_normal, "Tied and untied are the same") -or do { +is( $enc_tied, $enc_normal, "Tied and untied are the same" ) + or do { diag "Normal:\n"; hobodecode $enc_normal; diag "Tied: \n"; hobodecode $enc_tied; -}; + }; if ($have_decoder) { my $dec= Sereal::Decoder->new(); my $dec_tied= $dec->decode($enc_tied); my $dec_normal= $dec->decode($enc_normal); - foreach my $i (0..$#keys) { - is($dec_tied->{$keys[$i]},$i, "decoded tied"); - is($dec_normal->{$keys[$i]},$i, "decoded normal"); - is($new_std_hash{$keys[$i]},$i, "original tied"); - is($normal_hash{$keys[$i]},$i, "original normal"); + foreach my $i ( 0 .. $#keys ) { + is( $dec_tied->{ $keys[$i] }, $i, "decoded tied" ); + is( $dec_normal->{ $keys[$i] }, $i, "decoded normal" ); + is( $new_std_hash{ $keys[$i] }, $i, "original tied" ); + is( $normal_hash{ $keys[$i] }, $i, "original normal" ); } } diff -Nru libsereal-perl-4.007/t/060_each.t libsereal-perl-4.011/t/060_each.t --- libsereal-perl-4.007/t/060_each.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/060_each.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -11,7 +12,7 @@ use Sereal::TestSet qw(:all); use Sereal::Decoder; -if (have_encoder_and_decoder()) { +if ( have_encoder_and_decoder() ) { plan tests => 1004; } else { @@ -23,16 +24,17 @@ for ( 1 .. 1000, [ 'a' .. 'z' ], [ 'A' .. 'Z' ], [ 0 .. 100 ], [ 10000 .. 10512 ] ) { my %hash; - if (ref $_) { + if ( ref $_ ) { $hash{$_}++ for @$_; - } else { - $hash{rand()}++ for 1..26; } - my $undump= $d->decode($e->encode(\%hash)); + else { + $hash{ rand() }++ for 1 .. 26; + } + my $undump= $d->decode( $e->encode( \%hash ) ); my $count= 0; - while( my ($h, $k)= each %$undump ) { + while ( my ( $h, $k )= each %$undump ) { $count++; } - is($count, keys %hash, "Got the expected count of keys: [ @{[ sort keys %hash ]} ]"); + is( $count, keys %hash, "Got the expected count of keys: [ @{[ sort keys %hash ]} ]" ); } diff -Nru libsereal-perl-4.007/t/070_alias_options.t libsereal-perl-4.011/t/070_alias_options.t --- libsereal-perl-4.007/t/070_alias_options.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/070_alias_options.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -11,47 +12,50 @@ use Sereal::TestSet qw(:all); my @tests= ( - [ 15, alias_smallint => 1 ], - [ 127, alias_varint_under => 128 ], + [ 15, alias_smallint => 1 ], + [ 127, alias_varint_under => 128 ], ); -if (have_encoder_and_decoder()) { +if ( have_encoder_and_decoder() ) { my $num_tests= 0; - $num_tests += ((16 + $_->[0] + 2) * 2) for @tests; + $num_tests += ( ( 16 + $_->[0] + 2 ) * 2 ) for @tests; plan tests => $num_tests; -} else { +} +else { plan skip_all => 'Did not find right version of encoder'; } foreach my $test (@tests) { - my ($up_to, $opt, $opt_val)= @$test; + my ( $up_to, $opt, $opt_val )= @$test; + #diag "$up_to: $opt $opt_val"; - my $enc = Sereal::Encoder->new; - my $dec = Sereal::Decoder->new( { $opt => $opt_val } ); + my $enc= Sereal::Encoder->new; + my $dec= Sereal::Decoder->new( { $opt => $opt_val } ); my $struct= { - array => [-16 .. $up_to], - array2 => [reverse -16 .. $up_to], + array => [ -16 .. $up_to ], + array2 => [ reverse -16 .. $up_to ], map { $_ => $_ } -16 .. $up_to, }; - my $got= $dec->decode($enc->encode($struct)); + my $got= $dec->decode( $enc->encode($struct) ); # undef the decoder to make sure if it blows up on DESTROY it does it before we test. undef $dec; undef $enc; # Make sure we get the expected aliases - for (-16..$up_to) { - ok(\$got->{array}[$_+16] == \$got->{array2}[- 1 - ($_+16)],"$opt: array alias: $_"); - ok(\$got->{$_} == \$got->{array}[$_+16],"$opt: array alias: $_"); + for ( -16 .. $up_to ) { + ok( + \$got->{array}[ $_ + 16 ] == \$got->{array2}[ -1 - ( $_ + 16 ) ], + "$opt: array alias: $_" + ); + ok( \$got->{$_} == \$got->{array}[ $_ + 16 ], "$opt: array alias: $_" ); } # Make sure the aliases are readonly. - my $eval_ok= eval { - $got->{$up_to}= 123; - }; - my $error= $eval_ok ? "" : ("$@" || "Zombie error"); - ok(!$eval_ok,"$opt: expect modification of \$got->{$up_to} to die"); - like($error,qr/read-only/,"$opt: expect an error about read-only values"); + my $eval_ok= eval { $got->{$up_to}= 123; }; + my $error= $eval_ok ? "" : ( "$@" || "Zombie error" ); + ok( !$eval_ok, "$opt: expect modification of \$got->{$up_to} to die" ); + like( $error, qr/read-only/, "$opt: expect an error about read-only values" ); } diff -Nru libsereal-perl-4.007/t/080_set_readonly.t libsereal-perl-4.011/t/080_set_readonly.t --- libsereal-perl-4.007/t/080_set_readonly.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/080_set_readonly.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,84 +14,90 @@ use Scalar::Util qw(reftype weaken); my @tests= ( - [ set_readonly => 1 ], + [ set_readonly => 1 ], ); -if (have_encoder_and_decoder()) { +if ( have_encoder_and_decoder() ) { my $num_tests= 62; plan tests => $num_tests; -} else { +} +else { plan skip_all => 'Did not find right version of encoder'; } -my $foo = bless([ 1, 2, 3 ],"foo"); +my $foo= bless( [ 1, 2, 3 ], "foo" ); -my $weak_blessed_href = bless({ blah => 'bat', hash => { t => 1 } }, 'SomeClass'); -weaken($weak_blessed_href->{foo} = $weak_blessed_href); +my $weak_blessed_href= bless( { blah => 'bat', hash => { t => 1 } }, 'SomeClass' ); +weaken( $weak_blessed_href->{foo}= $weak_blessed_href ); my $struct= { - hashref => { a => [ "b", 5, bless({ foo => "bar"}, "SomeClass")] }, - blessed_ref_with_refs => bless({ foo => { bar => 'test' }, bar => ['baz'], empty_href => {}, empty_aref => [] }, 'Blah'), - string => "foobar", - arrayref => [ "foobar" ], - blessed_arrayref => $foo, + hashref => { a => [ "b", 5, bless( { foo => "bar" }, "SomeClass" ) ] }, + blessed_ref_with_refs => bless( + { foo => { bar => 'test' }, bar => ['baz'], empty_href => {}, empty_aref => [] }, 'Blah' + ), + string => "foobar", + arrayref => ["foobar"], + blessed_arrayref => $foo, weak_blessed_href => $weak_blessed_href, }; foreach my $name ( keys %$struct ) { - local $_ = $struct->{$name}; - my $enc = Sereal::Encoder->new; - my $dec = Sereal::Decoder->new( { set_readonly => 1 } ); - my $dec2 = Sereal::Decoder->new( { set_readonly_scalars => 1 } ); + local $_= $struct->{$name}; + my $enc= Sereal::Encoder->new; + my $dec= Sereal::Decoder->new( { set_readonly => 1 } ); + my $dec2= Sereal::Decoder->new( { set_readonly_scalars => 1 } ); my $got; - $dec->decode($enc->encode($_), $got); + $dec->decode( $enc->encode($_), $got ); my $got2; - $dec2->decode($enc->encode($_), $got2); + $dec2->decode( $enc->encode($_), $got2 ); # undef the decoder to make sure if it blows up on DESTROY it does it before we test. undef $dec; undef $dec2; undef $enc; - _recurse($got, '', $name, 0); - _recurse($got2, '', $name, 1); + _recurse( $got, '', $name, 0 ); + _recurse( $got2, '', $name, 1 ); } sub _recurse { - my ($s, $path, $name, $scalars_only) = @_; + my ( $s, $path, $name, $scalars_only )= @_; $scalars_only ||= 0; - my $should_be_readonly = $scalars_only ? !ref($s) : 1; - is(Internals::SvREADONLY( $_[0] ), $should_be_readonly, - "scalar_only: '$scalars_only'. We want ro: '$should_be_readonly'. struct: $name, path: $path" - ); + my $should_be_readonly= $scalars_only ? !ref($s) : 1; + is( + Internals::SvREADONLY( $_[0] ), $should_be_readonly, + "scalar_only: '$scalars_only'. We want ro: '$should_be_readonly'. struct: $name, path: $path" + ); - my $reftype = reftype($_[0]) + my $reftype= reftype( $_[0] ) or return; if ( length($path) ) { - is(&Internals::SvREADONLY( $_[0] ), $should_be_readonly, + is( + &Internals::SvREADONLY( $_[0] ), $should_be_readonly, "scalar_only: '$scalars_only'. We want ro: '$should_be_readonly'. struct: $name, path: $path" ); } - if ($reftype eq 'ARRAY') { - my $i = 0; + if ( $reftype eq 'ARRAY' ) { + my $i= 0; foreach (@$s) { - _recurse($_, $path . '->[' . $i . ']', $name, $scalars_only); + _recurse( $_, $path . '->[' . $i . ']', $name, $scalars_only ); } } - elsif ($reftype eq 'HASH') { - foreach (keys %$s) { - next if reftype($s->{$_}) && $s->{$_} == $s; - _recurse($s->{$_}, $path . '->{' . $_ . '}', $name, $scalars_only); + elsif ( $reftype eq 'HASH' ) { + foreach ( keys %$s ) { + next if reftype( $s->{$_} ) && $s->{$_} == $s; + _recurse( $s->{$_}, $path . '->{' . $_ . '}', $name, $scalars_only ); } - } elsif ($reftype eq 'SCALAR') { - _recurse($$s, '${' . $path . '}', $name, $scalars_only); - } else { + } + elsif ( $reftype eq 'SCALAR' ) { + _recurse( $$s, '${' . $path . '}', $name, $scalars_only ); + } + else { die "unknown ref type '$reftype'"; } } - diff -Nru libsereal-perl-4.007/t/110_nobless.t libsereal-perl-4.011/t/110_nobless.t --- libsereal-perl-4.007/t/110_nobless.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/110_nobless.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use File::Spec; use Scalar::Util qw( blessed ); use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,33 +14,33 @@ use Test::More; use Sereal::Encoder; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of decoder'; } else { - my $class = 'MyFoo'; - my %hash = ( x => 1 ); - my $object = bless( \%hash, $class ); - my $dec = Sereal::Decoder->new(); + my $class= 'MyFoo'; + my %hash= ( x => 1 ); + my $object= bless( \%hash, $class ); + my $dec= Sereal::Decoder->new(); # do not bless anything { - my $enc = Sereal::Encoder->new({ no_bless_objects => 1 }); - my $blob = $enc->encode( $object ); + my $enc= Sereal::Encoder->new( { no_bless_objects => 1 } ); + my $blob= $enc->encode($object); - my $data = $dec->decode( $blob ); + my $data= $dec->decode($blob); - ok( ref( $data ) && !blessed( $data ), 'reference without class' ); + ok( ref($data) && !blessed($data), 'reference without class' ); is_deeply( $data, \%hash, 'same structure' ); } # normally do the blessing { - my $enc = Sereal::Encoder->new(); - my $blob = $enc->encode( $object ); + my $enc= Sereal::Encoder->new(); + my $blob= $enc->encode($object); - my $data = $dec->decode( $blob ); + my $data= $dec->decode($blob); is_deeply( $data, $object, 'same structure' ); isa_ok( $data, $class, 'same class' ); diff -Nru libsereal-perl-4.007/t/120_hdr_data.t libsereal-perl-4.011/t/120_hdr_data.t --- libsereal-perl-4.007/t/120_hdr_data.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/120_hdr_data.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use File::Spec; use Scalar::Util qw( blessed ); use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -14,27 +15,27 @@ use Sereal::Encoder::Constants qw(:all); use Test::More; -my $ref = Header(SRL_PROTOCOL_VERSION, chr(0b0000_1100)) . chr(0b0001_0000); # -16 in body, 12 in header -is(encode_sereal_with_header_data(-16, 12), $ref, "Encode 12 in header, -16 in body"); -is(Sereal::Encoder->new->encode(-16, 12), $ref, "OO: Encode 12 in header, -16 in body"); +my $ref= Header( SRL_PROTOCOL_VERSION, chr(0b0000_1100) ) . chr(0b0001_0000); # -16 in body, 12 in header +is( encode_sereal_with_header_data( -16, 12 ), $ref, "Encode 12 in header, -16 in body" ); +is( Sereal::Encoder->new->encode( -16, 12 ), $ref, "OO: Encode 12 in header, -16 in body" ); -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { SKIP: { skip 'Did not find right version of decoder' => 1 } } else { - my $dec = Sereal::Decoder->new; - my $encoded = encode_sereal_with_header_data(-16, 12); - my $decoded = $dec->decode($encoded); - is($decoded, -16, "-16 decoded correctly"); - $decoded = $dec->decode_only_header($encoded); - is($decoded, 12, "12 decoded correctly"); - - my $munged = "X" . $encoded; - $decoded = $dec->decode_with_offset($munged, 1); - is($decoded, -16, "-16 decoded correctly (offset)"); - $decoded = $dec->decode_only_header_with_offset($munged, 1); - is($decoded, 12, "12 decoded correctly (offset)"); + my $dec= Sereal::Decoder->new; + my $encoded= encode_sereal_with_header_data( -16, 12 ); + my $decoded= $dec->decode($encoded); + is( $decoded, -16, "-16 decoded correctly" ); + $decoded= $dec->decode_only_header($encoded); + is( $decoded, 12, "12 decoded correctly" ); + + my $munged= "X" . $encoded; + $decoded= $dec->decode_with_offset( $munged, 1 ); + is( $decoded, -16, "-16 decoded correctly (offset)" ); + $decoded= $dec->decode_only_header_with_offset( $munged, 1 ); + is( $decoded, 12, "12 decoded correctly (offset)" ); } pass("Alive at end"); diff -Nru libsereal-perl-4.007/t/130_freezethaw.t libsereal-perl-4.011/t/130_freezethaw.t --- libsereal-perl-4.007/t/130_freezethaw.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/130_freezethaw.t 2020-02-02 17:25:40.000000000 +0000 @@ -1,105 +1,112 @@ #!perl use strict; use warnings; + # must be loaded before Sereal::TestSet use File::Spec; use Test::More; use Data::Dumper; use lib File::Spec->catdir(qw(t lib)); + BEGIN { - lib->import('lib') - if !-d 't'; + lib->import('lib') + if !-d 't'; } use Sereal::TestSet qw(:all); use Sereal::Encoder qw(encode_sereal); use Sereal::Encoder::Constants qw(:all); -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of decoder'; exit 0; } -my $thaw_called = 0; -my $freeze_called = 0; +my $thaw_called= 0; +my $freeze_called= 0; package Foo; + sub new { - my $class = shift; - return bless({bar => 1, @_} => $class); + my $class= shift; + return bless( { bar => 1, @_ } => $class ); } sub FREEZE { - my ($self, $serializer) = @_; - $freeze_called = $serializer eq 'Sereal' ? 1 : 0; - return "frozen object", 12, [2]; + my ( $self, $serializer )= @_; + $freeze_called= $serializer eq 'Sereal' ? 1 : 0; + return "frozen object", 12, [2]; } sub THAW { - my ($class, $serializer, @data) = @_; - $thaw_called = $serializer eq 'Sereal' ? 1 : 0; - Test::More::is_deeply(\@data, ["frozen object", 12, [2]], "Array of frozen values roundtrips"); + my ( $class, $serializer, @data )= @_; + $thaw_called= $serializer eq 'Sereal' ? 1 : 0; + Test::More::is_deeply( + \@data, [ "frozen object", 12, [2] ], + "Array of frozen values roundtrips" + ); - return Foo->new(); + return Foo->new(); } package Bar; + sub new { - my $class = shift; - return bless({bar => 1, @_} => $class); + my $class= shift; + return bless( { bar => 1, @_ } => $class ); } sub FREEZE { - my ($self, $serializer) = @_; - return "frozen Bar"; + my ( $self, $serializer )= @_; + return "frozen Bar"; } package main; -my $enc = Sereal::Encoder->new({freeze_callbacks => 1}); -my $srl = $enc->encode(Foo->new()); -ok($freeze_called, "FREEZE was invoked"); - +my $enc= Sereal::Encoder->new( { freeze_callbacks => 1 } ); +my $srl= $enc->encode( Foo->new() ); +ok( $freeze_called, "FREEZE was invoked" ); # Simple round-trip test -my $dec = Sereal::Decoder->new; -my $obj = $dec->decode($srl); -ok(defined($obj)); -isa_ok($obj, "Foo"); -is(eval{$obj->{bar}}, 1) or diag Dumper($obj); +my $dec= Sereal::Decoder->new; +my $obj= $dec->decode($srl); +ok( defined($obj) ); +isa_ok( $obj, "Foo" ); +is( eval { $obj->{bar} }, 1 ) or diag Dumper($obj); # Test referential integrity -my $foo = Foo->new; -my $data = [$foo, $foo]; -$srl = $enc->encode($data); -ok($srl =~ /frozen object/); - -my $out = $dec->decode($srl); -is_deeply($out, $data, "Roundtrip works"); - -cmp_ok($out->[0], "eq", $out->[1], - "Referential integrity: multiple RVs do not turn into clones") - or diag(Dumper($data,$out)); - -my $barobj = Bar->new; -$srl = $enc->encode($barobj); -ok(not(eval {$dec->decode($srl); 1}), "Decoding without THAW barfs"); - +my $foo= Foo->new; +my $data= [ $foo, $foo ]; +$srl= $enc->encode($data); +ok( $srl =~ /frozen object/ ); + +my $out= $dec->decode($srl); +is_deeply( $out, $data, "Roundtrip works" ); + +cmp_ok( + $out->[0], "eq", $out->[1], + "Referential integrity: multiple RVs do not turn into clones" +) or diag( Dumper( $data, $out ) ); + +my $barobj= Bar->new; +$srl= $enc->encode($barobj); +ok( not( eval { $dec->decode($srl); 1 } ), "Decoding without THAW barfs" ); # Multiple-object-same-class test from Christian Hansen { + package MyObject; sub from_num { - my ($class, $num) = @_; + my ( $class, $num )= @_; return bless { num => $num }, $class; } sub num { - my ($self) = @_; + my ($self)= @_; return $self->{num}; } @@ -108,24 +115,23 @@ } sub THAW { - my ($class, undef, $num) = @_; + my ( $class, undef, $num )= @_; return $class->from_num($num); } } -my @objects = map { MyObject->from_num($_) } (10, 20, 30); -my $encoded = encode_sereal([ @objects ], { freeze_callbacks => 1 }); -my $decoded = Sereal::Decoder::decode_sereal($encoded); - -isa_ok($decoded, 'ARRAY'); -is(scalar @$decoded, 3, 'array has three elements'); -isa_ok($decoded->[0], 'MyObject', 'first element'); -isa_ok($decoded->[1], 'MyObject', 'second element'); -isa_ok($decoded->[2], 'MyObject', 'third element'); - -is($decoded->[0]->num, 10, 'first MyObject->num'); -is($decoded->[1]->num, 20, 'second MyObject->num'); -is($decoded->[2]->num, 30, 'third MyObject->num'); - +my @objects= map { MyObject->from_num($_) } ( 10, 20, 30 ); +my $encoded= encode_sereal( [@objects], { freeze_callbacks => 1 } ); +my $decoded= Sereal::Decoder::decode_sereal($encoded); + +isa_ok( $decoded, 'ARRAY' ); +is( scalar @$decoded, 3, 'array has three elements' ); +isa_ok( $decoded->[0], 'MyObject', 'first element' ); +isa_ok( $decoded->[1], 'MyObject', 'second element' ); +isa_ok( $decoded->[2], 'MyObject', 'third element' ); + +is( $decoded->[0]->num, 10, 'first MyObject->num' ); +is( $decoded->[1]->num, 20, 'second MyObject->num' ); +is( $decoded->[2]->num, 30, 'third MyObject->num' ); done_testing(); diff -Nru libsereal-perl-4.007/t/150_dec_exception.t libsereal-perl-4.011/t/150_dec_exception.t --- libsereal-perl-4.007/t/150_dec_exception.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/150_dec_exception.t 2020-02-02 17:25:40.000000000 +0000 @@ -6,6 +6,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -20,72 +21,76 @@ # memory. plan tests => 56; -my ($ok, $out, $err); +my ( $ok, $out, $err ); SCOPE: { - check_fail(Header(), qr/Not a valid Sereal document/i, "Cannot decode just header"); + check_fail( Header(), qr/Not a valid Sereal document/i, "Cannot decode just header" ); - my $badheaderpacket = "srX".chr(SRL_PROTOCOL_VERSION) . chr(0) . integer(1); - check_fail($badheaderpacket, qr/Bad Sereal header/i, "Packet with invalid header blows up"); + my $badheaderpacket= "srX" . chr(SRL_PROTOCOL_VERSION) . chr(0) . integer(1); + check_fail( $badheaderpacket, qr/Bad Sereal header/i, "Packet with invalid header blows up" ); - my $bad_nested_packet = Header() . array(integer(1), 7777); - check_fail($bad_nested_packet, qr/Sereal: Error/, "Random crap in packet"); + my $bad_nested_packet= Header() . array( integer(1), 7777 ); + check_fail( $bad_nested_packet, qr/Sereal: Error/, "Random crap in packet" ); - my $obj_packet = Header() . chr(SRL_HDR_OBJECT).short_string("Foo").chr(SRL_HDR_REFN).integer(1); - check_fail($obj_packet, qr/refuse_obj/, "refusing objects option", {refuse_objects => 1}); + my $obj_packet= + Header() . chr(SRL_HDR_OBJECT) . short_string("Foo") . chr(SRL_HDR_REFN) . integer(1); + check_fail( $obj_packet, qr/refuse_obj/, "refusing objects option", { refuse_objects => 1 } ); # strictly speaking not entirely correct; also: +16 for the snappy flag isn't exactly API - my $h = SRL_MAGIC_STRING . chr(1+16) . chr(0) . chr(SRL_HDR_UNDEF); - check_fail($h, qr/Snappy/, "refusing Snappy option", {refuse_snappy => 1}); + my $h= SRL_MAGIC_STRING . chr( 1 + 16 ) . chr(0) . chr(SRL_HDR_UNDEF); + check_fail( $h, qr/Snappy/, "refusing Snappy option", { refuse_snappy => 1 } ); # Tests for limiting number of acceptable hash entries - my $hash_packet = Header() . hash(map short_string($_), 1..2000); - $h = decode_sereal($hash_packet); - is(ref($h), "HASH", "Deserializes as hash"); - is(scalar(keys(%$h)), 1000, "Hash has 1000 entries"); - $h = decode_sereal($hash_packet, {max_num_hash_entries => 0}); - is(ref($h), "HASH", "Deserializes as hash (2)"); - $h = decode_sereal($hash_packet, {max_num_hash_entries => 1000}); - is(ref($h), "HASH", "Deserializes as hash (3)"); - - check_fail($hash_packet, qr/Sereal: Error/, "Setting hash limit option (1)", {max_num_hash_entries => 1}); - check_fail($hash_packet, qr/Sereal: Error/, "Setting hash limit option (999)", {max_num_hash_entries => 999}); - - my $valid_packet = Header(2) . short_string("foo"); - my $foo = decode_sereal($valid_packet); - is($foo, "foo", "Have valid test packet"); + my $hash_packet= Header() . hash( map short_string($_), 1 .. 2000 ); + $h= decode_sereal($hash_packet); + is( ref($h), "HASH", "Deserializes as hash" ); + is( scalar( keys(%$h) ), 1000, "Hash has 1000 entries" ); + $h= decode_sereal( $hash_packet, { max_num_hash_entries => 0 } ); + is( ref($h), "HASH", "Deserializes as hash (2)" ); + $h= decode_sereal( $hash_packet, { max_num_hash_entries => 1000 } ); + is( ref($h), "HASH", "Deserializes as hash (3)" ); + + check_fail( + $hash_packet, qr/Sereal: Error/, "Setting hash limit option (1)", + { max_num_hash_entries => 1 } ); + check_fail( + $hash_packet, qr/Sereal: Error/, "Setting hash limit option (999)", + { max_num_hash_entries => 999 } ); + + my $valid_packet= Header(2) . short_string("foo"); + my $foo= decode_sereal($valid_packet); + is( $foo, "foo", "Have valid test packet" ); $valid_packet =~ s/^=srl/=\xF3rl/; - $foo = eval { decode_sereal($valid_packet) }; - ok(!defined($foo), "SRL_MAGIC_STRING_HIGHBIT implies protocol v3 or higher."); + $foo= eval { decode_sereal($valid_packet) }; + ok( !defined($foo), "SRL_MAGIC_STRING_HIGHBIT implies protocol v3 or higher." ); - substr($valid_packet,4,1,chr(3)); - $foo = eval { decode_sereal($valid_packet) }; - is($foo,"foo", "Have valid test packet after asserting high bit in magic with protocol v3"); + substr( $valid_packet, 4, 1, chr(3) ); + $foo= eval { decode_sereal($valid_packet) }; + is( $foo, "foo", "Have valid test packet after asserting high bit in magic with protocol v3" ); utf8::encode($valid_packet); - check_fail($valid_packet, qr/UTF-8/, "Sereal determined 'accidental' UTF8 upgrade"); + check_fail( $valid_packet, qr/UTF-8/, "Sereal determined 'accidental' UTF8 upgrade" ); } -pass("Alive"); # done - +pass("Alive"); # done sub check_fail { - my ($data, $err_like, $name, $options) = @_; + my ( $data, $err_like, $name, $options )= @_; $options ||= {}; - my ($ok, $out, $err); - ($ok, $out, $err) = dec_func($data, $options); - expect_fail($ok, $out, $err, $err_like, $name . "(func)"); - ($ok, $out, $err) = dec_obj($data, $options); - expect_fail($ok, $out, $err, $err_like, $name . "(OO)"); + my ( $ok, $out, $err ); + ( $ok, $out, $err )= dec_func( $data, $options ); + expect_fail( $ok, $out, $err, $err_like, $name . "(func)" ); + ( $ok, $out, $err )= dec_obj( $data, $options ); + expect_fail( $ok, $out, $err, $err_like, $name . "(OO)" ); } sub expect_fail { - my ($ok, $out, $err, $err_like, $name) = @_; - ok(!$ok, "$name, got exception"); - ok(!defined($out), "$name, got no output"); - if (defined $err_like) { - like($err, $err_like, "$name, matched exception"); + my ( $ok, $out, $err, $err_like, $name )= @_; + ok( !$ok, "$name, got exception" ); + ok( !defined($out), "$name, got no output" ); + if ( defined $err_like ) { + like( $err, $err_like, "$name, matched exception" ); } else { diag($err); @@ -93,24 +98,23 @@ } sub dec_func { - my ($ok, $out); - $ok = eval { - $out = decode_sereal(@_); - 1 + my ( $ok, $out ); + $ok= eval { + $out= decode_sereal(@_); + 1; }; - my $err = $@ || 'Zombie error'; - return($ok, $out, $err); + my $err= $@ || 'Zombie error'; + return ( $ok, $out, $err ); } - sub dec_obj { - my ($ok, $out); - my $obj = Sereal::Decoder->new(@_ > 1 ? $_[1] : {}); - $ok = eval { - $out = $obj->decode(@_); - 1 + my ( $ok, $out ); + my $obj= Sereal::Decoder->new( @_ > 1 ? $_[1] : {} ); + $ok= eval { + $out= $obj->decode(@_); + 1; }; - my $err = $@ || 'Zombie error'; - return($ok, $out, $err); + my $err= $@ || 'Zombie error'; + return ( $ok, $out, $err ); } diff -Nru libsereal-perl-4.007/t/160_recursion.t libsereal-perl-4.011/t/160_recursion.t --- libsereal-perl-4.007/t/160_recursion.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/160_recursion.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,18 +14,18 @@ use Sereal::TestSet; use Sereal::Encoder qw(encode_sereal); -my $recur_depth = 1000; -my $ref = []; -my $pos = $ref; -$pos = $pos->[0] = [] for 1..$recur_depth-1; +my $recur_depth= 1000; +my $ref= []; +my $pos= $ref; +$pos= $pos->[0]= [] for 1 .. $recur_depth - 1; -my $out = encode_sereal($ref, {max_recursion_depth => $recur_depth+1}); +my $out= encode_sereal( $ref, { max_recursion_depth => $recur_depth + 1 } ); pass("alive"); -my $no_exception = eval { - $out = encode_sereal($ref, {max_recursion_depth => $recur_depth-1}); - 1 +my $no_exception= eval { + $out= encode_sereal( $ref, { max_recursion_depth => $recur_depth - 1 } ); + 1; }; -ok(!$no_exception); +ok( !$no_exception ); done_testing(); note("All done folks!"); diff -Nru libsereal-perl-4.007/t/170_cyclic_weakrefs.t libsereal-perl-4.011/t/170_cyclic_weakrefs.t --- libsereal-perl-4.007/t/170_cyclic_weakrefs.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/170_cyclic_weakrefs.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,9 +4,10 @@ use File::Spec; use Scalar::Util qw /weaken/; -local $| = 1; +local $|= 1; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -17,29 +18,28 @@ use Test::More; use Sereal::Encoder; - -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of decoder'; } else { run_weakref_tests(); } - sub run_weakref_tests { + # Child to parent refs are weak, root node is stored once in the hash # Was failing on x64 Strawberry perls 5.16.3, 5.18.4, 5.20.1 - test_save_and_reload (); - + test_save_and_reload(); + # Child to parent refs are weak, but we store the root node twice in the hash # (second time is in the "TREE_BY_NAME" subhash) # Was failing on x64 Strawberry perls 5.16.3, passing on 5.18.4, 5.20.1 - test_save_and_reload (store_root_by_name => 1); - + test_save_and_reload( store_root_by_name => 1 ); + # child to parent refs are strong # Should pass - test_save_and_reload (no_weaken_refs => 1); + test_save_and_reload( no_weaken_refs => 1 ); } pass(); @@ -47,72 +47,72 @@ exit; - sub get_data { - my %args = @_; + my %args= @_; my @children; - my $root = { + my $root= { name => 'root', children => \@children, }; - my %hash = ( - TREE => $root, + my %hash= ( + TREE => $root, TREE_BY_NAME => {}, ); - if ($args{store_root_by_name}) { - $hash{TREE_BY_NAME}{root} = $root; + if ( $args{store_root_by_name} ) { + $hash{TREE_BY_NAME}{root}= $root; } - foreach my $i (0 .. 1) { - my $child = { + foreach my $i ( 0 .. 1 ) { + my $child= { PARENT => $root, - NAME => $i, + NAME => $i, }; - if (!$args{no_weaken_refs}) { + if ( !$args{no_weaken_refs} ) { weaken $child->{PARENT}; } push @children, $child; + # store it in the by-name cache - $hash{TREE_BY_NAME}{$i} = $child; + $hash{TREE_BY_NAME}{$i}= $child; } return \%hash; } - sub test_save_and_reload { - my %args = @_; - my $data = get_data (%args); + my %args= @_; + my $data= get_data(%args); #diag '=== ARGS ARE: ' . join ' ', %args; my $context_text; $context_text .= $args{no_weaken} ? 'not weakened' : 'weakened'; - $context_text .= $args{store_root_by_name} + $context_text .= + $args{store_root_by_name} ? ', extra root ref stored' : ', extra root ref not stored'; - my $encoder = Sereal::Encoder->new; - my $decoder = Sereal::Decoder->new; - my ($encoded_data, $decoded_data); - - $encoded_data = eval {$encoder->encode($data)}; - my $e = $@; - ok (!$e, "Encoded without exception, $context_text"); + my $encoder= Sereal::Encoder->new; + my $decoder= Sereal::Decoder->new; + my ( $encoded_data, $decoded_data ); + + $encoded_data= eval { $encoder->encode($data) }; + my $e= $@; + ok( !$e, "Encoded without exception, $context_text" ); # no point testing if serialisation failed if ($encoded_data) { - eval {$decoder->decode ($encoded_data, $decoded_data)}; - my $e = $@; - ok (!$e, "Decoded using Sereal, $context_text"); + eval { $decoder->decode( $encoded_data, $decoded_data ) }; + my $e= $@; + ok( !$e, "Decoded using Sereal, $context_text" ); - is_deeply ( + is_deeply( $decoded_data, $data, "Data structures match, $context_text", @@ -121,5 +121,4 @@ } - 1; diff -Nru libsereal-perl-4.007/t/200_bulk.t libsereal-perl-4.011/t/200_bulk.t --- libsereal-perl-4.007/t/200_bulk.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/200_bulk.t 2020-02-02 17:25:40.000000000 +0000 @@ -8,6 +8,7 @@ # bulk data testing. use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -18,13 +19,13 @@ use Test::More; use Sereal::Encoder; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of decoder'; } else { - my %opt = ( - bench => scalar(grep /^--bench$/, @ARGV), + my %opt= ( + bench => scalar( grep /^--bench$/, @ARGV ), ); run_bulk_tests(%opt); } diff -Nru libsereal-perl-4.007/t/210_bulk_readonly.t libsereal-perl-4.011/t/210_bulk_readonly.t --- libsereal-perl-4.007/t/210_bulk_readonly.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/210_bulk_readonly.t 2020-02-02 17:25:40.000000000 +0000 @@ -8,6 +8,7 @@ # bulk data testing. use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -18,15 +19,15 @@ use Test::More; use Sereal::Decoder; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - my %opt = ( - bench => scalar(grep /^--bench$/, @ARGV), + my %opt= ( + bench => scalar( grep /^--bench$/, @ARGV ), ); - run_bulk_tests(%opt, decoder_options => { set_readonly => 1}); + run_bulk_tests( %opt, decoder_options => { set_readonly => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/300_fail.t libsereal-perl-4.011/t/300_fail.t --- libsereal-perl-4.007/t/300_fail.t 2017-11-12 20:16:47.000000000 +0000 +++ libsereal-perl-4.011/t/300_fail.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,9 +5,10 @@ use Test::Warn; use lib File::Spec->catdir(qw(t lib)); + BEGIN { - lib->import('lib') - if !-d 't'; + lib->import('lib') + if !-d 't'; } use Sereal::TestSet qw(:all); @@ -15,91 +16,96 @@ use Sereal::Encoder; use Sereal::Encoder::Constants qw(:all); + BEGIN { - if (not have_encoder_and_decoder()) { + if ( not have_encoder_and_decoder() ) { plan skip_all => 'Did not find right version of decoder'; exit 0; - } else { + } + else { plan tests => 19; } } use Sereal::Decoder; -my ($ok, $err, $out); +my ( $ok, $err, $out ); # croak_on_bless test SCOPE: { - my $e = Sereal::Encoder->new({ + my $e= Sereal::Encoder->new( { croak_on_bless => 1, - }); + } ); - is($e->encode(1), Header().integer(1), "Encoder works before exception"); - $ok = eval{$out = $e->encode(bless({}, "Foo")); 1}; - $err = $@ || 'Zombie error'; + is( $e->encode(1), Header() . integer(1), "Encoder works before exception" ); + $ok= eval { $out= $e->encode( bless( {}, "Foo" ) ); 1 }; + $err= $@ || 'Zombie error'; - ok(!$ok, "Object throws exception"); - ok($err =~ /object/i, 'Exception refers to object'); + ok( !$ok, "Object throws exception" ); + ok( $err =~ /object/i, 'Exception refers to object' ); - is($e->encode(1), Header().integer(1), "Encoder works after exception"); + is( $e->encode(1), Header() . integer(1), "Encoder works after exception" ); - $ok = eval {$out = $e->encode({}); 1}; - ok($ok, "Non-blessed hash does not throw exception"); + $ok= eval { $out= $e->encode( {} ); 1 }; + ok( $ok, "Non-blessed hash does not throw exception" ); # test that code refs throw exception - $ok = eval {$out = $e->encode(sub {}); 1}; - ok(!$ok, "Code ref throws exception"); + $ok= eval { + $out= $e->encode( sub { } ); 1; + }; + ok( !$ok, "Code ref throws exception" ); } # test that code refs with undef_unknown don't throw exceptions SCOPE: { - my $e = Sereal::Encoder->new({undef_unknown => 1}); - $ok = eval {$out = $e->encode(sub{}); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "undef_unknown makes CODE encoding not fail"); - is($out, Header() . chr(SRL_HDR_UNDEF), "output is undef") - or do { + my $e= Sereal::Encoder->new( { undef_unknown => 1 } ); + $ok= eval { + $out= $e->encode( sub { } ); 1; + }; + $err= $@ || 'Zombie error'; + ok( $ok, "undef_unknown makes CODE encoding not fail" ); + is( $out, Header() . chr(SRL_HDR_UNDEF), "output is undef" ) + or do { hobodecode($out) if $ENV{DEBUG_SEREAL}; } } # test that code refs with stringify_unknown don't throw exceptions SCOPE: { - my $e = Sereal::Encoder->new({stringify_unknown => 1}); - my $sub = sub{}; - $ok = eval {$out = $e->encode($sub); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "stringify_unknown makes CODE encoding not fail"); - - my $str = $e->encode("$sub"); - is($out, $str, "output is stringified ref") - or do { + my $e= Sereal::Encoder->new( { stringify_unknown => 1 } ); + my $sub= sub { }; + $ok= eval { $out= $e->encode($sub); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "stringify_unknown makes CODE encoding not fail" ); + + my $str= $e->encode("$sub"); + is( $out, $str, "output is stringified ref" ) + or do { hobodecode($out), hobodecode($str) if $ENV{DEBUG_SEREAL}; } } # test that code refs with warn_unknown do warn SCOPE: { - my $e = Sereal::Encoder->new({stringify_unknown => 1, warn_unknown => 1}); - my $sub = sub{}; - warning_like - { - $ok = eval {$out = $e->encode($sub); 1}; - } - qr/Sereal/, + my $e= Sereal::Encoder->new( { stringify_unknown => 1, warn_unknown => 1 } ); + my $sub= sub { }; + warning_like { + $ok= eval { $out= $e->encode($sub); 1 }; + } + qr/Sereal/, "warn_unknown warns about stringified sub"; } # test that blessed code refs with stringify_unknown don't throw exceptions SCOPE: { - my $e = Sereal::Encoder->new({stringify_unknown => 1}); - my $sub = bless(sub {}, "Foo"); - $ok = eval {$out = $e->encode($sub); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "stringify_unknown makes CODE encoding not fail"); - - my $str = $e->encode("$sub"); - is($out, $str, "output is stringified ref") - or do { + my $e= Sereal::Encoder->new( { stringify_unknown => 1 } ); + my $sub= bless( sub { }, "Foo" ); + $ok= eval { $out= $e->encode($sub); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "stringify_unknown makes CODE encoding not fail" ); + + my $str= $e->encode("$sub"); + is( $out, $str, "output is stringified ref" ) + or do { hobodecode($out), hobodecode($str) if $ENV{DEBUG_SEREAL}; } } @@ -107,57 +113,59 @@ # dito for string overloading SCOPE: { SCOPE2: { + package BlessedCodeRefOverload; - use overload '""' => sub {$_[0]->()}; + use overload '""' => sub { $_[0]->() }; + sub new { - my ($class, $data) = @_; - bless sub {return $data} => __PACKAGE__; + my ( $class, $data )= @_; + bless sub { return $data } => __PACKAGE__; } } SCOPE3: { + package BlessedCodeRef; + sub new { - my ($class, $data) = @_; - bless sub {return $data} => __PACKAGE__; + my ( $class, $data )= @_; + bless sub { return $data } => __PACKAGE__; } } - my $e = Sereal::Encoder->new({stringify_unknown => 1}); - my $sub = BlessedCodeRefOverload->new("hello"); - is("$sub", "hello", "BlessedCodeRefOverload stringification actually works as designed"); - - $ok = eval {$out = $e->encode($sub); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "stringify_unknown makes CODE encoding not fail"); - - my $str = $e->encode("$sub"); - is($out, $str, "output is stringified ref") - or do { + my $e= Sereal::Encoder->new( { stringify_unknown => 1 } ); + my $sub= BlessedCodeRefOverload->new("hello"); + is( "$sub", "hello", "BlessedCodeRefOverload stringification actually works as designed" ); + + $ok= eval { $out= $e->encode($sub); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "stringify_unknown makes CODE encoding not fail" ); + + my $str= $e->encode("$sub"); + is( $out, $str, "output is stringified ref" ) + or do { hobodecode($out), hobodecode($str) if $ENV{DEBUG_SEREAL}; - }; + }; # test that we get a warning with warn_unknown - $e = Sereal::Encoder->new({stringify_unknown => 1, warn_unknown => 1}); - warning_like - { - $ok = eval {$out = $e->encode($sub); 1}; - } - qr/Sereal/, + $e= Sereal::Encoder->new( { stringify_unknown => 1, warn_unknown => 1 } ); + warning_like { + $ok= eval { $out= $e->encode($sub); 1 }; + } + qr/Sereal/, "warn_unknown warns about stringified sub despite overloading"; # Test that we do NOT get a warning with warn_unknown set to -1 # FIXME Test::Warn doesn't have a "no_warnings" function, so let's just # run this for now and hope the user will be spooked by the warning # if there is one. Duh. - $e = Sereal::Encoder->new({stringify_unknown => 1, warn_unknown => -1}); - $out = $e->encode($sub); - ok(defined $out && $out !~ /CODE/ && $out !~ "Blessed", "RV of encode makes some sense"); + $e= Sereal::Encoder->new( { stringify_unknown => 1, warn_unknown => -1 } ); + $out= $e->encode($sub); + ok( defined $out && $out !~ /CODE/ && $out !~ "Blessed", "RV of encode makes some sense" ); # Test that we DO get a warning for non-overloaded unsupported stuff - my $sub2 = BlessedCodeRef->new("hello"); - warning_like - { - $ok = eval {$out = $e->encode($sub2); 1}; - } - qr/Sereal/, + my $sub2= BlessedCodeRef->new("hello"); + warning_like { + $ok= eval { $out= $e->encode($sub2); 1 }; + } + qr/Sereal/, "warn_unknown == -1 warns about stringified sub without overloading"; } diff -Nru libsereal-perl-4.007/t/300_overload.t libsereal-perl-4.011/t/300_overload.t --- libsereal-perl-4.007/t/300_overload.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/300_overload.t 2020-02-02 17:25:40.000000000 +0000 @@ -9,6 +9,7 @@ # objects in funny circumstances. use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -18,8 +19,8 @@ use Test::More; use Sereal::Decoder; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; done_testing(); exit(0); @@ -27,16 +28,15 @@ require Sereal::Encoder; -my $encoder = Sereal::Encoder->new({ +my $encoder= Sereal::Encoder->new( { stringify_unknown => 1, - warn_unknown => 1, -}); + warn_unknown => 1, +} ); # encode before any overload is known -my $s = $encoder->encode(bless({foo => "123"} => "Str")); - -my $decoder = Sereal::Decoder->new(); +my $s= $encoder->encode( bless( { foo => "123" } => "Str" ) ); +my $decoder= Sereal::Decoder->new(); # "load" the object's class eval <<'HERE'; @@ -53,39 +53,39 @@ # Yves: Move this to where the class wasn't loaded yet, and the tests fail # (which indicates overload hooking into bless and adding magic to the # object {{citation required}}) -my $obj = $decoder->decode($s); +my $obj= $decoder->decode($s); + # FOR YVES: #use Devel::Peek; #Dump($obj); # see if overload magic is on object -is("$obj", 123, "Deserialized object serializes fine"); -$Str::Called = $Str::Called; # silence warning -is($Str::Called, 1, "overload invoked once"); - +is( "$obj", 123, "Deserialized object serializes fine" ); +$Str::Called= $Str::Called; # silence warning +is( $Str::Called, 1, "overload invoked once" ); # Second try at breaking things SCOPE: { - my $enc = Sereal::Encoder->new({ - warn_unknown => 1, + my $enc= Sereal::Encoder->new( { + warn_unknown => 1, stringify_unknown => 1, - }); + } ); - my $dec = Sereal::Decoder->new; + my $dec= Sereal::Decoder->new; package Foo; - use overload '""' => sub {return $_[0]->{str}}; + use overload '""' => sub { return $_[0]->{str} }; package main; - my $p = bless({str => "asd"} => 'Foo'); - my $h = [ $p, $p ]; - my $s = $enc->encode($h); - my $d = $dec->decode($s); + my $p= bless( { str => "asd" } => 'Foo' ); + my $h= [ $p, $p ]; + my $s= $enc->encode($h); + my $d= $dec->decode($s); #warn "$_" for @$d; - my $x = join ",", @$d; - is($x, "asd,asd", "overload stringification works for second object occurrence"); + my $x= join ",", @$d; + is( $x, "asd,asd", "overload stringification works for second object occurrence" ); #warn $x; } diff -Nru libsereal-perl-4.007/t/400_evil.t libsereal-perl-4.011/t/400_evil.t --- libsereal-perl-4.007/t/400_evil.t 2017-11-12 20:37:09.000000000 +0000 +++ libsereal-perl-4.011/t/400_evil.t 2020-02-02 17:25:40.000000000 +0000 @@ -9,6 +9,7 @@ # Perl data structures such as overloaded and tied structures. use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -17,7 +18,7 @@ use Sereal::TestSet qw(:all); use Test::More; -if (not have_encoder_and_decoder()) { +if ( not have_encoder_and_decoder() ) { plan skip_all => 'Did not find right version of decoder'; exit 0; } @@ -31,168 +32,182 @@ # tiedness in the output. { SCOPE: { + package TiedHash; require Tie::Hash; - our @ISA = qw(Tie::StdHash); + our @ISA= qw(Tie::StdHash); } - my %testhash = ( - foo => [qw(a b c)], - baz => 123, + my %testhash= ( + foo => [qw(a b c)], + baz => 123, dfvgbnhmjk => "345ty6ujh", - a => undef, + a => undef, ); my %tied_hash; tie %tied_hash => 'TiedHash'; - %{tied(%tied_hash)} = %testhash; - is_deeply(\%tied_hash, \%testhash); + %{ tied(%tied_hash) }= %testhash; + is_deeply( \%tied_hash, \%testhash ); - my ($out, $ok, $err, $data); - $ok = eval {$out = encode_sereal(\%tied_hash); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "serializing tied hash did not die") + my ( $out, $ok, $err, $data ); + $ok= eval { $out= encode_sereal( \%tied_hash ); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "serializing tied hash did not die" ) or note("Error was '$err'"); - ok(defined $out, "serializing tied hash returns string"); + ok( defined $out, "serializing tied hash returns string" ); - $ok = eval {$data = decode_sereal($out); 1;}; - $err = $@ || 'Zombie error'; - ok($ok, "deserializing tied hash did not die") + $ok= eval { $data= decode_sereal($out); 1; }; + $err= $@ || 'Zombie error'; + ok( $ok, "deserializing tied hash did not die" ) or note("Error was '$err', data was:\n"), hobodecode($out); - ok(defined $data, "deserializing tied hash yields defined output"); - is_deeply($data, \%testhash, "deserializing tied hash yields expected output"); + ok( defined $data, "deserializing tied hash yields defined output" ); + is_deeply( $data, \%testhash, "deserializing tied hash yields expected output" ); } - # Now tied arrays. { SCOPE: { + package TiedArray; require Tie::Array; - our @ISA = qw(Tie::StdArray); + our @ISA= qw(Tie::StdArray); } - my @testarray = (1, 2, "foo", "bar", []); + my @testarray= ( 1, 2, "foo", "bar", [] ); my @tied_array; tie @tied_array => 'TiedArray'; - @{tied(@tied_array)} = @testarray; - is_deeply(\@tied_array, \@testarray); + @{ tied(@tied_array) }= @testarray; + is_deeply( \@tied_array, \@testarray ); - my ($out, $ok, $err, $data); - $ok = eval {$out = encode_sereal(\@tied_array); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "serializing tied array did not die") + my ( $out, $ok, $err, $data ); + $ok= eval { $out= encode_sereal( \@tied_array ); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "serializing tied array did not die" ) or note("Error was '$err'"); - ok(defined $out, "serializing tied array returns string"); + ok( defined $out, "serializing tied array returns string" ); - $ok = eval {$data = decode_sereal($out); 1;}; - $err = $@ || 'Zombie error'; - ok($ok, "deserializing tied array did not die") + $ok= eval { $data= decode_sereal($out); 1; }; + $err= $@ || 'Zombie error'; + ok( $ok, "deserializing tied array did not die" ) or note("Error was '$err', data was:\n"), hobodecode($out); - ok(defined $data, "deserializing tied array yields defined output"); - is_deeply($data, \@testarray, "deserializing tied array yields expected output"); + ok( defined $data, "deserializing tied array yields defined output" ); + is_deeply( $data, \@testarray, "deserializing tied array yields expected output" ); } # Now tied scalars. { SCOPE: { + package TiedScalar; require Tie::Scalar; - our @ISA = qw(Tie::StdScalar); + our @ISA= qw(Tie::StdScalar); } - my $testscalar = [qw(foo bar baz)]; + my $testscalar= [qw(foo bar baz)]; my $tied_scalar; tie $tied_scalar => 'TiedScalar'; - ${tied($tied_scalar)} = $testscalar; - is_deeply($tied_scalar, $testscalar); + ${ tied($tied_scalar) }= $testscalar; + is_deeply( $tied_scalar, $testscalar ); + + my ( $out, $ok, $err, $data ); + $ok= eval { $out= encode_sereal( \$tied_scalar ); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "serializing tied scalar did not die" ) + or note("Error was '$err'"); + ok( defined $out, "serializing tied scalar returns string" ); - my ($out, $ok, $err, $data); - $ok = eval {$out = encode_sereal(\$tied_scalar); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "serializing tied scalar did not die") - or note("Error was '$err'"); - ok(defined $out, "serializing tied scalar returns string"); - - $ok = eval {$data = decode_sereal($out); 1;}; - $err = $@ || 'Zombie error'; - ok($ok, "deserializing tied scalar did not die") - or note("Error was '$err', data was:\n"), hobodecode($out); - ok(defined $data, "deserializing tied scalar yields defined output"); - is_deeply($data, \$testscalar, "deserializing tied scalar yields expected output"); + $ok= eval { $data= decode_sereal($out); 1; }; + $err= $@ || 'Zombie error'; + ok( $ok, "deserializing tied scalar did not die" ) + or note("Error was '$err', data was:\n"), hobodecode($out); + ok( defined $data, "deserializing tied scalar yields defined output" ); + is_deeply( $data, \$testscalar, "deserializing tied scalar yields expected output" ); } # Now test re-entrancy. DO NOT DO THIS AT HOME! SCOPE: { - my $enc = Sereal::Encoder->new; - my $die_run = 0; + my $enc= Sereal::Encoder->new; + my $die_run= 0; eval { - local $SIG{__DIE__} = sub { + local $SIG{__DIE__}= sub { $die_run++; - ok(defined($enc->encode("foo")), "encode does not segfault"); + ok( defined( $enc->encode("foo") ), "encode does not segfault" ); $die_run++; }; - $enc->encode(["foo", sub{}]); + $enc->encode( [ "foo", sub { } ] ); }; - ok($die_run == 2, "__DIE__ called, encode 2 did not die ($die_run)"); + ok( $die_run == 2, "__DIE__ called, encode 2 did not die ($die_run)" ); } # github Sereal/Sereal issue 7 regression test: SCOPE: { { - package # hide from PAUSE + package # hide from PAUSE Blessed::Sub::With::Overload; use overload '""' => sub { shift->() }; sub new { bless $_[1] => $_[0] } } { - package # hide from PAUSE + package # hide from PAUSE Blessed::Sub::With::Lazy::Overload; use overload '""' => sub { - my ($self) = @_; + my ($self)= @_; return $self->[1] if defined $self->[1]; return "OH NOES WE DON'T HAVE A SUB" unless ref $self->[0] eq 'CODE'; - return ($self->[1] = $self->[0]->()); + return ( $self->[1]= $self->[0]->() ); }; + sub new { bless [ # The callback $_[1], + # Cached value undef - ] => $_[0] + ] => $_[0]; } } my $data; - $data->[0] = sub {}; - $data->[1] = $data->[0]; - $data->[2] = Blessed::Sub::With::Overload->new(sub { "hello there" }); - $data->[3] = $data->[2]; - $data->[4] = Blessed::Sub::With::Overload->new(sub { \"hello there" }); - $data->[5] = $data->[4]; + $data->[0]= sub { }; + $data->[1]= $data->[0]; + $data->[2]= Blessed::Sub::With::Overload->new( sub { "hello there" } ); + $data->[3]= $data->[2]; + $data->[4]= Blessed::Sub::With::Overload->new( sub { \"hello there" } ); + $data->[5]= $data->[4]; my $called; - $data->[6] = Blessed::Sub::With::Overload->new(sub { $called++; "hello there" }); - $data->[7] = $data->[6]; - $data->[8] = $data->[6]; - $data->[9] = $data->[6]; - $data->[10] = Blessed::Sub::With::Lazy::Overload->new(sub { "hello there" }); - $data->[11] = $data->[10]; + $data->[6]= Blessed::Sub::With::Overload->new( sub { $called++; "hello there" } ); + $data->[7]= $data->[6]; + $data->[8]= $data->[6]; + $data->[9]= $data->[6]; + $data->[10]= Blessed::Sub::With::Lazy::Overload->new( sub { "hello there" } ); + $data->[11]= $data->[10]; + + my $encode= encode_sereal( $data, { stringify_unknown => 1 } ); - my $encode = encode_sereal($data, {stringify_unknown => 1}); # Before 48d5cdc3dc07fd29ac7be05678a0b614244fec4f, we'd # die here because $data->[1] is a ref to something that doesn't exist anymore - my $decode = decode_sereal($encode); + my $decode= decode_sereal($encode); - is($decode->[0], $decode->[1]); - is($decode->[2], $decode->[3]); - is($decode->[4], $decode->[5]); - is($decode->[6], $decode->[$_]) for 7..9; - is($called, 4, "We'll call the sub every time, and won't re-use the initial return value"); - ok(blessed($decode->[10]), "We won't be stringifying objects"); - like($decode->[10]->[0], qr/^CODE\(.*?\)$/, "And the subroutine we have will just be stringified as usual in Perl"); - is("$decode->[10]", "OH NOES WE DON'T HAVE A SUB", "So our subroutine won't survive the roundtrip, our object is broken"); - is_deeply($decode->[10], $decode->[11], "Both the original and the reference to it are equally screwed"); + is( $decode->[0], $decode->[1] ); + is( $decode->[2], $decode->[3] ); + is( $decode->[4], $decode->[5] ); + is( $decode->[6], $decode->[$_] ) for 7 .. 9; + is( $called, 4, "We'll call the sub every time, and won't re-use the initial return value" ); + ok( blessed( $decode->[10] ), "We won't be stringifying objects" ); + like( + $decode->[10]->[0], qr/^CODE\(.*?\)$/, + "And the subroutine we have will just be stringified as usual in Perl" + ); + is( + "$decode->[10]", "OH NOES WE DON'T HAVE A SUB", + "So our subroutine won't survive the roundtrip, our object is broken" + ); + is_deeply( + $decode->[10], $decode->[11], + "Both the original and the reference to it are equally screwed" + ); } pass("Alive at end"); diff -Nru libsereal-perl-4.007/t/400_utf8validate.t libsereal-perl-4.011/t/400_utf8validate.t --- libsereal-perl-4.007/t/400_utf8validate.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/400_utf8validate.t 2020-02-02 17:25:40.000000000 +0000 @@ -7,30 +7,36 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { - lib->import('lib') - if !-d 't'; + lib->import('lib') + if !-d 't'; } use Sereal::TestSet; use Sereal::Decoder qw(decode_sereal); no warnings 'utf8'; -my @valid_utf8 = ( - [ latin1 => "=srl\x01\x00'\x06Au feu" => 'Au feu' ], - [ utf8 => "=srl\x01\x00'\x08\xc3\x80 l'eau" => "\xC0 l'eau" ], +my @valid_utf8= ( + [ latin1 => "=srl\x01\x00'\x06Au feu" => 'Au feu' ], + [ utf8 => "=srl\x01\x00'\x08\xc3\x80 l'eau" => "\xC0 l'eau" ], [ bom => "=srl\x01\x00'\x06\xEF\xBB\xBFfoo" => "\x{FEFF}foo" ], + # Invalid code points that are nonetheless valid UTF8 : # FFFE is a non-character - [ fffe => "=srl\x01\x00'\x03\xEF\xBF\xBE" => "\x{FFFE}" ], + [ fffe => "=srl\x01\x00'\x03\xEF\xBF\xBE" => "\x{FFFE}" ], + # This is binary, not utf8, so must not throw an error [ ffpadded => "=srl\x01\x00&\x04\xFF\xFF\xFF\xFF" => "\xFF\xFF\xFF\xFF" ], ); -my @invalid_utf8 = ( +my @invalid_utf8= ( + # Only FF bytes [ ffpadded => "=srl\x01\x00'\x04\xFF\xFF\xFF\xFF" ], + # Overlong encoding F0 82 82 AC for U+20AC [ overlong => "=srl\x01\x00'\x04\xF0\x82\x82\xAC" ], + # Not enough contination bytes [ continuation => "=srl\x01\x00'\x01\xC0" ], ); @@ -38,31 +44,31 @@ plan tests => 2 * @valid_utf8 + 2 * @invalid_utf8; for my $test (@valid_utf8) { - my ($name, $exp, $expected) = @$test; + my ( $name, $exp, $expected )= @$test; my $out; - my $ok = eval { decode_sereal($exp, { validate_utf8 => 1 }, $out); 1 }; - my $err = $@ || 'Zombie error'; - ok($ok,"$name: did not die") + my $ok= eval { decode_sereal( $exp, { validate_utf8 => 1 }, $out ); 1 }; + my $err= $@ || 'Zombie error'; + ok( $ok, "$name: did not die" ) or do { - diag $err; - diag "input=", Data::Dumper::qquote($exp); - next; + diag $err; + diag "input=", Data::Dumper::qquote($exp); + next; }; - is($out, $expected, "$name: correctly decoded"); + is( $out, $expected, "$name: correctly decoded" ); } for my $test (@invalid_utf8) { - my ($name, $exp) = @$test; + my ( $name, $exp )= @$test; my $out; - my $ok = eval { decode_sereal($exp, undef, $out); 1 }; - my $err = $@ || 'Zombie error'; - ok($ok,"$name: did not die") + my $ok= eval { decode_sereal( $exp, undef, $out ); 1 }; + my $err= $@ || 'Zombie error'; + ok( $ok, "$name: did not die" ) or do { - diag $err; - diag "input=", Data::Dumper::qquote($exp); - next; + diag $err; + diag "input=", Data::Dumper::qquote($exp); + next; }; - $ok = eval { decode_sereal($exp, { validate_utf8 => 1 }, $out); 1 }; - $err = $@ || 'Zombie error'; - like($err, qr/Invalid UTF8 byte sequence/, "$name: die with a UTF8 error"); + $ok= eval { decode_sereal( $exp, { validate_utf8 => 1 }, $out ); 1 }; + $err= $@ || 'Zombie error'; + like( $err, qr/Invalid UTF8 byte sequence/, "$name: die with a UTF8 error" ); } diff -Nru libsereal-perl-4.007/t/500_utf8decoding.t libsereal-perl-4.011/t/500_utf8decoding.t --- libsereal-perl-4.007/t/500_utf8decoding.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/500_utf8decoding.t 2020-02-02 17:25:40.000000000 +0000 @@ -6,14 +6,16 @@ use File::Spec; use Encode; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; } use Sereal::TestSet qw(have_encoder_and_decoder); + BEGIN { - my $ok = have_encoder_and_decoder(); - if (not $ok) { + my $ok= have_encoder_and_decoder(); + if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; done_testing(); exit(0); @@ -25,27 +27,26 @@ # Each test below will use the supplied encoder against # the supplied input data structure and will compare how # the decoder behaves with its output marked as utf8 or not -my @tests = ( - { +my @tests= ( { # First round of tests, with a snappy-compressed structure, # crafted to yield high-bit data points - encoder => Sereal::Encoder->new({ snappy => 1, snappy_threshold => 0 }), - input => { - foo => 'bar', - f111 => 'bar', - f1111 => 'bar', - f11111 => 'bar', - f111111 => 'bar', - f1111111 => 'bar', - f11111111 => 'bar', - f111111111 => 'bar', - f1111111111 => 'bar', - f11111111111 => 'bar', - f111111111111 => 'bar', - f1111111111111 => 'bar', - f11111111111111 => 'bar', - f111111111111111 => 'bar', - f1111111111111111 => 'bar', + encoder => Sereal::Encoder->new( { snappy => 1, snappy_threshold => 0 } ), + input => { + foo => 'bar', + f111 => 'bar', + f1111 => 'bar', + f11111 => 'bar', + f111111 => 'bar', + f1111111 => 'bar', + f11111111 => 'bar', + f111111111 => 'bar', + f1111111111 => 'bar', + f11111111111 => 'bar', + f111111111111 => 'bar', + f1111111111111 => 'bar', + f11111111111111 => 'bar', + f111111111111111 => 'bar', + f1111111111111111 => 'bar', f11111111111111111 => 'bar', }, }, @@ -53,37 +54,37 @@ # Second round of testing, this time do not use snappy, but # encode directly utf8 data encoder => Sereal::Encoder->new, - input => { therefore => "\x{2234}" }, + input => { therefore => "\x{2234}" }, }, ); plan tests => 9 * @tests; # The testing routine sub encode_and_encode { - my ($encoder, $input) = @_; - my $s1 = $encoder->encode($input); - my $s2 = $s1; - ok(!utf8::is_utf8($s1), "encoder returns a string without the utf8 flag"); - $s2 = encode("utf8", $s2); + my ( $encoder, $input )= @_; + my $s1= $encoder->encode($input); + my $s2= $s1; + ok( !utf8::is_utf8($s1), "encoder returns a string without the utf8 flag" ); + $s2= encode( "utf8", $s2 ); Encode::_utf8_on($s2); - ok(utf8::is_utf8($s2), "the copy of the string has the utf8 flag turned on"); - is($s1, $s2, "the strings are still the same for perl"); + ok( utf8::is_utf8($s2), "the copy of the string has the utf8 flag turned on" ); + is( $s1, $s2, "the strings are still the same for perl" ); my $output; - my $ok = eval { decode_sereal($s1, { validate_utf8 => 1 }, $output); 1 }; - my $err = $@ || 'Zombie error'; - ok($ok, "did not die while decoding the first string") or diag $err; - is(ref $output, 'HASH', "correctly decoded to a hashref"); - is_deeply($output, $input, "correctly decoded"); + my $ok= eval { decode_sereal( $s1, { validate_utf8 => 1 }, $output ); 1 }; + my $err= $@ || 'Zombie error'; + ok( $ok, "did not die while decoding the first string" ) or diag $err; + is( ref $output, 'HASH', "correctly decoded to a hashref" ); + is_deeply( $output, $input, "correctly decoded" ); undef $output; - $ok = eval { decode_sereal($s2, { validate_utf8 => 1 }, $output); 1 }; - $err = $@ || 'Zombie error'; - ok($ok, "did not die while decoding the utf8 string") or diag $err; - is(ref $output, 'HASH', "correctly decoded to a hashref"); - is_deeply($output, $input, "correctly decoded"); + $ok= eval { decode_sereal( $s2, { validate_utf8 => 1 }, $output ); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "did not die while decoding the utf8 string" ) or diag $err; + is( ref $output, 'HASH', "correctly decoded to a hashref" ); + is_deeply( $output, $input, "correctly decoded" ); } for my $t (@tests) { - encode_and_encode($t->{encoder}, $t->{input}); + encode_and_encode( $t->{encoder}, $t->{input} ); } diff -Nru libsereal-perl-4.007/t/550_decode_into.t libsereal-perl-4.011/t/550_decode_into.t --- libsereal-perl-4.007/t/550_decode_into.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/550_decode_into.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use Test::More tests => 8; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -19,23 +20,23 @@ # We alternate between ref and scalar to see if we can trigger a segfault. my $into; -$decoder->decode($enc_ref, $into); -ok(ref $into, "first decode was a reference"); -$decoder->decode($enc_str, $into); -ok(!ref $into, "second decode was a string"); - -$decoder->decode($enc_ref, $into); -ok(ref $into, "third decode was a reference"); -$decoder->decode($enc_str, $into); -ok(!ref $into, "fourth decode was a string (and did not segfault)"); - -$decoder->decode($enc_ref, $into); -ok(ref $into, "fifth decode was a reference - and did not segault"); -$decoder->decode($enc_str, $into); -ok(!ref $into, "sixth decode was a string - and did not segfault, probably ok"); - -$decoder->decode($enc_ref, $into); -ok(ref $into, "seventh decode was a reference - maybe overkill"); -$decoder->decode($enc_str, $into); -ok(!ref $into, "eight decode was a string - maybe overkill"); +$decoder->decode( $enc_ref, $into ); +ok( ref $into, "first decode was a reference" ); +$decoder->decode( $enc_str, $into ); +ok( !ref $into, "second decode was a string" ); + +$decoder->decode( $enc_ref, $into ); +ok( ref $into, "third decode was a reference" ); +$decoder->decode( $enc_str, $into ); +ok( !ref $into, "fourth decode was a string (and did not segfault)" ); + +$decoder->decode( $enc_ref, $into ); +ok( ref $into, "fifth decode was a reference - and did not segault" ); +$decoder->decode( $enc_str, $into ); +ok( !ref $into, "sixth decode was a string - and did not segfault, probably ok" ); + +$decoder->decode( $enc_ref, $into ); +ok( ref $into, "seventh decode was a reference - maybe overkill" ); +$decoder->decode( $enc_str, $into ); +ok( !ref $into, "eight decode was a string - maybe overkill" ); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v1/plain_canon.t libsereal-perl-4.011/t/700_roundtrip/v1/plain_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v1/plain_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v1/plain_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests("plain_canonical", { canonical => 1 }); + run_roundtrip_tests( "plain_canonical", { canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v1/plain.t libsereal-perl-4.011/t/700_roundtrip/v1/plain.t --- libsereal-perl-4.007/t/700_roundtrip/v1/plain.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v1/plain.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -15,8 +16,8 @@ my $version; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { diff -Nru libsereal-perl-4.007/t/700_roundtrip/v1/snappy_canon.t libsereal-perl-4.011/t/700_roundtrip/v1/snappy_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v1/snappy_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v1/snappy_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests('snappy_canon', { snappy => 1, canonical => 1 } ); + run_roundtrip_tests( 'snappy_canon', { snappy => 1, canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v1/snappy.t libsereal-perl-4.011/t/700_roundtrip/v1/snappy.t --- libsereal-perl-4.007/t/700_roundtrip/v1/snappy.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v1/snappy.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,15 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests('snappy', { snappy => 1 } ); + run_roundtrip_tests( 'snappy', { snappy => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/dedudep_strings.t libsereal-perl-4.011/t/700_roundtrip/v2/dedudep_strings.t --- libsereal-perl-4.007/t/700_roundtrip/v2/dedudep_strings.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/dedudep_strings.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'dedupe_strings', { dedupe_strings => 1 } - ); + run_roundtrip_tests( 'dedupe_strings', { dedupe_strings => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/freeze_thaw.t libsereal-perl-4.011/t/700_roundtrip/v2/freeze_thaw.t --- libsereal-perl-4.007/t/700_roundtrip/v2/freeze_thaw.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/freeze_thaw.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'freeze-thaw', { freeze_callbacks => 1 } - ); + run_roundtrip_tests( 'freeze-thaw', { freeze_callbacks => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/plain_canon.t libsereal-perl-4.011/t/700_roundtrip/v2/plain_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v2/plain_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/plain_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests("plain_canonical", { canonical => 1 }); + run_roundtrip_tests( "plain_canonical", { canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/plain.t libsereal-perl-4.011/t/700_roundtrip/v2/plain.t --- libsereal-perl-4.007/t/700_roundtrip/v2/plain.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/plain.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -15,8 +16,8 @@ my $version; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/readonly.t libsereal-perl-4.011/t/700_roundtrip/v2/readonly.t --- libsereal-perl-4.007/t/700_roundtrip/v2/readonly.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/readonly.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'readonly', { set_readonly => 1 } - ); + run_roundtrip_tests( 'readonly', { set_readonly => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/snappy_canon.t libsereal-perl-4.011/t/700_roundtrip/v2/snappy_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v2/snappy_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/snappy_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests('snappy_canon', { snappy => 1, canonical => 1 } ); + run_roundtrip_tests( 'snappy_canon', { snappy => 1, canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/snappy_incr_canon.t libsereal-perl-4.011/t/700_roundtrip/v2/snappy_incr_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v2/snappy_incr_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/snappy_incr_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests('snappy_incr_canon', { snappy_incr => 1, canonical => 1 }); + run_roundtrip_tests( 'snappy_incr_canon', { snappy_incr => 1, canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/snappy_incr.t libsereal-perl-4.011/t/700_roundtrip/v2/snappy_incr.t --- libsereal-perl-4.007/t/700_roundtrip/v2/snappy_incr.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/snappy_incr.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'snappy_incr', { snappy_incr => 1 } - ); + run_roundtrip_tests( 'snappy_incr', { snappy_incr => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/snappy.t libsereal-perl-4.011/t/700_roundtrip/v2/snappy.t --- libsereal-perl-4.007/t/700_roundtrip/v2/snappy.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/snappy.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,15 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests('snappy', { snappy => 1 } ); + run_roundtrip_tests( 'snappy', { snappy => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v2/sort_keys.t libsereal-perl-4.011/t/700_roundtrip/v2/sort_keys.t --- libsereal-perl-4.007/t/700_roundtrip/v2/sort_keys.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v2/sort_keys.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'sort_keys', { sort_keys => 1 } - ); + run_roundtrip_tests( 'sort_keys', { sort_keys => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/dedudep_strings.t libsereal-perl-4.011/t/700_roundtrip/v3/dedudep_strings.t --- libsereal-perl-4.007/t/700_roundtrip/v3/dedudep_strings.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/dedudep_strings.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'dedupe_strings', { dedupe_strings => 1 } - ); + run_roundtrip_tests( 'dedupe_strings', { dedupe_strings => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/freeze_thaw.t libsereal-perl-4.011/t/700_roundtrip/v3/freeze_thaw.t --- libsereal-perl-4.007/t/700_roundtrip/v3/freeze_thaw.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/freeze_thaw.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'freeze-thaw', { freeze_callbacks => 1 } - ); + run_roundtrip_tests( 'freeze-thaw', { freeze_callbacks => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/plain_canon.t libsereal-perl-4.011/t/700_roundtrip/v3/plain_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v3/plain_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/plain_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests("plain_canonical", { canonical => 1 }); + run_roundtrip_tests( "plain_canonical", { canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/plain.t libsereal-perl-4.011/t/700_roundtrip/v3/plain.t --- libsereal-perl-4.007/t/700_roundtrip/v3/plain.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/plain.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -15,8 +16,8 @@ my $version; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/readonly.t libsereal-perl-4.011/t/700_roundtrip/v3/readonly.t --- libsereal-perl-4.007/t/700_roundtrip/v3/readonly.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/readonly.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'readonly', { set_readonly => 1 } - ); + run_roundtrip_tests( 'readonly', { set_readonly => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/snappy_canon.t libsereal-perl-4.011/t/700_roundtrip/v3/snappy_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v3/snappy_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/snappy_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests('snappy_canon', { snappy => 1, canonical => 1 } ); + run_roundtrip_tests( 'snappy_canon', { snappy => 1, canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/snappy_incr_canon.t libsereal-perl-4.011/t/700_roundtrip/v3/snappy_incr_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v3/snappy_incr_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/snappy_incr_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests('snappy_incr_canon', { snappy_incr => 1, canonical => 1 }); + run_roundtrip_tests( 'snappy_incr_canon', { snappy_incr => 1, canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/snappy_incr.t libsereal-perl-4.011/t/700_roundtrip/v3/snappy_incr.t --- libsereal-perl-4.007/t/700_roundtrip/v3/snappy_incr.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/snappy_incr.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'snappy_incr', { snappy_incr => 1 } - ); + run_roundtrip_tests( 'snappy_incr', { snappy_incr => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/snappy.t libsereal-perl-4.011/t/700_roundtrip/v3/snappy.t --- libsereal-perl-4.007/t/700_roundtrip/v3/snappy.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/snappy.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,15 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests('snappy', { snappy => 1 } ); + run_roundtrip_tests( 'snappy', { snappy => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/sort_keys_perl_rev.t libsereal-perl-4.011/t/700_roundtrip/v3/sort_keys_perl_rev.t --- libsereal-perl-4.007/t/700_roundtrip/v3/sort_keys_perl_rev.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/sort_keys_perl_rev.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'sort_keys', { sort_keys => 3 } - ); + run_roundtrip_tests( 'sort_keys', { sort_keys => 3 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/sort_keys_perl.t libsereal-perl-4.011/t/700_roundtrip/v3/sort_keys_perl.t --- libsereal-perl-4.007/t/700_roundtrip/v3/sort_keys_perl.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/sort_keys_perl.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'sort_keys', { sort_keys => 2 } - ); + run_roundtrip_tests( 'sort_keys', { sort_keys => 2 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/sort_keys.t libsereal-perl-4.011/t/700_roundtrip/v3/sort_keys.t --- libsereal-perl-4.007/t/700_roundtrip/v3/sort_keys.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/sort_keys.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'sort_keys', { sort_keys => 1 } - ); + run_roundtrip_tests( 'sort_keys', { sort_keys => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/zlib_force.t libsereal-perl-4.011/t/700_roundtrip/v3/zlib_force.t --- libsereal-perl-4.007/t/700_roundtrip/v3/zlib_force.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/zlib_force.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,21 +14,19 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { run_roundtrip_tests( - 'zlib_force', - { - compress => Sereal::Encoder::SRL_ZLIB(), + 'zlib_force', + { + compress => Sereal::Encoder::SRL_ZLIB(), compress_threshold => 0, - } - ); + } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v3/zlib.t libsereal-perl-4.011/t/700_roundtrip/v3/zlib.t --- libsereal-perl-4.007/t/700_roundtrip/v3/zlib.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v3/zlib.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,20 +14,18 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { run_roundtrip_tests( - 'zlib', - { + 'zlib', + { compress => Sereal::Encoder::SRL_ZLIB(), - } - ); + } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/dedudep_strings.t libsereal-perl-4.011/t/700_roundtrip/v4/dedudep_strings.t --- libsereal-perl-4.007/t/700_roundtrip/v4/dedudep_strings.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/dedudep_strings.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'dedupe_strings', { dedupe_strings => 1 } - ); + run_roundtrip_tests( 'dedupe_strings', { dedupe_strings => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/freeze_thaw.t libsereal-perl-4.011/t/700_roundtrip/v4/freeze_thaw.t --- libsereal-perl-4.007/t/700_roundtrip/v4/freeze_thaw.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/freeze_thaw.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'freeze-thaw', { freeze_callbacks => 1 } - ); + run_roundtrip_tests( 'freeze-thaw', { freeze_callbacks => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/plain_canon.t libsereal-perl-4.011/t/700_roundtrip/v4/plain_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v4/plain_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/plain_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests("plain_canonical", { canonical => 1 }); + run_roundtrip_tests( "plain_canonical", { canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/plain.t libsereal-perl-4.011/t/700_roundtrip/v4/plain.t --- libsereal-perl-4.007/t/700_roundtrip/v4/plain.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/plain.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -15,8 +16,8 @@ my $version; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/readonly.t libsereal-perl-4.011/t/700_roundtrip/v4/readonly.t --- libsereal-perl-4.007/t/700_roundtrip/v4/readonly.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/readonly.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'readonly', { set_readonly => 1 } - ); + run_roundtrip_tests( 'readonly', { set_readonly => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/snappy_and_warn_unknown.t libsereal-perl-4.011/t/700_roundtrip/v4/snappy_and_warn_unknown.t --- libsereal-perl-4.007/t/700_roundtrip/v4/snappy_and_warn_unknown.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/snappy_and_warn_unknown.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,33 +14,32 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - my $e = Sereal::Encoder->new(); - my $d = Sereal::Decoder->new(); + my $e= Sereal::Encoder->new(); + my $d= Sereal::Decoder->new(); my $out; - my $payload = [ 'abcd' x 1024 ]; - my $ok = eval {$out = $e->encode($payload); 1}; - my $err = $@ || 'Zombie error'; - ok($ok, "snappy_incr and warn_unknown makes CODE encoding not fail"); + my $payload= [ 'abcd' x 1024 ]; + my $ok= eval { $out= $e->encode($payload); 1 }; + my $err= $@ || 'Zombie error'; + ok( $ok, "snappy_incr and warn_unknown makes CODE encoding not fail" ); my $decoded; - $ok = eval {$decoded = $d->decode($out); 1}; - $err = $@ || 'Zombie error'; - ok($ok, "snappy_incr and warn_unknown produced decodable output") - or do { + $ok= eval { $decoded= $d->decode($out); 1 }; + $err= $@ || 'Zombie error'; + ok( $ok, "snappy_incr and warn_unknown produced decodable output" ) + or do { diag($err); hobodecode($out) if $ENV{DEBUG_SEREAL}; - }; + }; - is_deeply($decoded, $payload, 'results matches'); + is_deeply( $decoded, $payload, 'results matches' ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/snappy_canon.t libsereal-perl-4.011/t/700_roundtrip/v4/snappy_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v4/snappy_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/snappy_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests('snappy_canon', { snappy => 1, canonical => 1 } ); + run_roundtrip_tests( 'snappy_canon', { snappy => 1, canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/snappy_incr_canon.t libsereal-perl-4.011/t/700_roundtrip/v4/snappy_incr_canon.t --- libsereal-perl-4.007/t/700_roundtrip/v4/snappy_incr_canon.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/snappy_incr_canon.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,13 +14,13 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); +my $ok= have_encoder_and_decoder(); $ok= 0 if $ok and $Sereal::Encoder::VERSION < 3.001006; -if (not $ok) { +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder (want 3.001006)'; } else { - run_roundtrip_tests('snappy_incr_canon', { snappy_incr => 1, canonical => 1 }); + run_roundtrip_tests( 'snappy_incr_canon', { snappy_incr => 1, canonical => 1 } ); } pass(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/snappy_incr.t libsereal-perl-4.011/t/700_roundtrip/v4/snappy_incr.t --- libsereal-perl-4.007/t/700_roundtrip/v4/snappy_incr.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/snappy_incr.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'snappy_incr', { snappy_incr => 1 } - ); + run_roundtrip_tests( 'snappy_incr', { snappy_incr => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/snappy.t libsereal-perl-4.011/t/700_roundtrip/v4/snappy.t --- libsereal-perl-4.007/t/700_roundtrip/v4/snappy.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/snappy.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,15 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests('snappy', { snappy => 1 } ); + run_roundtrip_tests( 'snappy', { snappy => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/sort_keys_perl_rev.t libsereal-perl-4.011/t/700_roundtrip/v4/sort_keys_perl_rev.t --- libsereal-perl-4.007/t/700_roundtrip/v4/sort_keys_perl_rev.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/sort_keys_perl_rev.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'sort_keys', { sort_keys => 3 } - ); + run_roundtrip_tests( 'sort_keys', { sort_keys => 3 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/sort_keys_perl.t libsereal-perl-4.011/t/700_roundtrip/v4/sort_keys_perl.t --- libsereal-perl-4.007/t/700_roundtrip/v4/sort_keys_perl.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/sort_keys_perl.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'sort_keys', { sort_keys => 2 } - ); + run_roundtrip_tests( 'sort_keys', { sort_keys => 2 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/sort_keys.t libsereal-perl-4.011/t/700_roundtrip/v4/sort_keys.t --- libsereal-perl-4.007/t/700_roundtrip/v4/sort_keys.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/sort_keys.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,17 +14,14 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { - run_roundtrip_tests( - 'sort_keys', { sort_keys => 1 } - ); + run_roundtrip_tests( 'sort_keys', { sort_keys => 1 } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/zlib_force.t libsereal-perl-4.011/t/700_roundtrip/v4/zlib_force.t --- libsereal-perl-4.007/t/700_roundtrip/v4/zlib_force.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/zlib_force.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,21 +14,19 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { run_roundtrip_tests( - 'zlib_force', - { - compress => Sereal::Encoder::SRL_ZLIB(), + 'zlib_force', + { + compress => Sereal::Encoder::SRL_ZLIB(), compress_threshold => 0, - } - ); + } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/zlib.t libsereal-perl-4.011/t/700_roundtrip/v4/zlib.t --- libsereal-perl-4.007/t/700_roundtrip/v4/zlib.t 2017-10-03 17:46:10.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/zlib.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,20 +14,18 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { run_roundtrip_tests( - 'zlib', - { + 'zlib', + { compress => Sereal::Encoder::SRL_ZLIB(), - } - ); + } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/zstd_force.t libsereal-perl-4.011/t/700_roundtrip/v4/zstd_force.t --- libsereal-perl-4.007/t/700_roundtrip/v4/zstd_force.t 2017-11-12 22:18:28.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/zstd_force.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,21 +14,19 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { run_roundtrip_tests( - 'zstd_force', - { - compress => Sereal::Encoder::SRL_ZSTD(), + 'zstd_force', + { + compress => Sereal::Encoder::SRL_ZSTD(), compress_threshold => 0, - } - ); + } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/700_roundtrip/v4/zstd.t libsereal-perl-4.011/t/700_roundtrip/v4/zstd.t --- libsereal-perl-4.007/t/700_roundtrip/v4/zstd.t 2017-11-12 22:20:41.000000000 +0000 +++ libsereal-perl-4.011/t/700_roundtrip/v4/zstd.t 2020-02-02 17:25:40.000000000 +0000 @@ -5,6 +5,7 @@ use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,20 +14,18 @@ use Sereal::TestSet qw(:all); use Test::More; -my $ok = have_encoder_and_decoder(); -if (not $ok) { +my $ok= have_encoder_and_decoder(); +if ( not $ok ) { plan skip_all => 'Did not find right version of encoder'; } else { run_roundtrip_tests( - 'zstd', - { + 'zstd', + { compress => Sereal::Encoder::SRL_ZSTD(), - } - ); + } ); } - pass(); done_testing(); diff -Nru libsereal-perl-4.007/t/800_threads.t libsereal-perl-4.011/t/800_threads.t --- libsereal-perl-4.007/t/800_threads.t 2017-10-03 17:46:05.000000000 +0000 +++ libsereal-perl-4.011/t/800_threads.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,18 +4,19 @@ use Test::More; BEGIN { - use Config; - if (! $Config{'useithreads'}) { - print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); - exit(0); - } - elsif ($] < 5.008007) { - print("1..0 # SKIP Sereal not thread safe on Perls before 5.8.7\n"); - exit(0); - } + use Config; + if ( !$Config{'useithreads'} ) { + print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); + exit(0); + } + elsif ( $] < 5.008007 ) { + print("1..0 # SKIP Sereal not thread safe on Perls before 5.8.7\n"); + exit(0); + } } use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -27,12 +28,12 @@ use threads; use threads::shared; -sub foo {} +sub foo { } SCOPE: { - my $dat= shared_clone([undef]); - my $enc = Sereal::Encoder->new; + my $dat= shared_clone( [undef] ); + my $enc= Sereal::Encoder->new; - my $thr = threads->new(\&foo); + my $thr= threads->new( \&foo ); $thr->join; my $encoded= $enc->encode($dat); } diff -Nru libsereal-perl-4.007/t/900_reentrancy.t libsereal-perl-4.011/t/900_reentrancy.t --- libsereal-perl-4.007/t/900_reentrancy.t 2017-11-10 17:33:15.000000000 +0000 +++ libsereal-perl-4.011/t/900_reentrancy.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -11,44 +12,43 @@ use Sereal::TestSet qw(:all); use Sereal::Encoder; -if (not have_encoder_and_decoder()) { +if ( not have_encoder_and_decoder() ) { plan skip_all => 'Did not find right version of decoder'; exit 0; } # Encoder reentrancy test courtesy of Zefram -my $enc = Sereal::Encoder->new({freeze_callbacks=>1}); +my $enc= Sereal::Encoder->new( { freeze_callbacks => 1 } ); package Foo; -sub FREEZE { $enc->encode($_[0]->{a}) } +sub FREEZE { $enc->encode( $_[0]->{a} ) } + sub THAW { - my $class = shift; - return bless( - {a => Sereal::Decoder->new->decode($_[1])} - => $class - ); + my $class= shift; + return bless( { a => Sereal::Decoder->new->decode( $_[1] ) } => $class ); } package main; -my $data = bless({a=>42},"Foo"); -my $a = $enc->encode($data); +my $data= bless( { a => 42 }, "Foo" ); +my $a= $enc->encode($data); my $output; my $err; eval { - $output = Sereal::Decoder->new->decode($a); - 1 -} -or do { - $err = $@ || "Zombie Error"; + $output= Sereal::Decoder->new->decode($a); + 1; +} or do { + $err= $@ || "Zombie Error"; }; -ok(!$err, "Decoding did not barf") - or diag("Decoding barfed with '$err'"); +ok( !$err, "Decoding did not barf" ) + or diag("Decoding barfed with '$err'"); -is_deeply($output, - $data, - "Decoded result is correct"); +is_deeply( + $output, + $data, + "Decoded result is correct" +); done_testing(); diff -Nru libsereal-perl-4.007/t/900_regr_issue_15.t libsereal-perl-4.011/t/900_regr_issue_15.t --- libsereal-perl-4.007/t/900_regr_issue_15.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/900_regr_issue_15.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -19,46 +20,47 @@ # is the same as compressed-data-length. SKIP: { - my $have_enc = have_encoder_and_decoder(); - if (not $have_enc) { + my $have_enc= have_encoder_and_decoder(); + if ( not $have_enc ) { skip "Need encoder for Snappy regression tests", 3; } else { require Sereal::Encoder; - my $encoder = Sereal::Encoder->new( { snappy_incr => 1, snappy_threshold => 1 } ); - my $decoder = Sereal::Decoder->new(); + my $encoder= Sereal::Encoder->new( { snappy_incr => 1, snappy_threshold => 1 } ); + my $decoder= Sereal::Decoder->new(); # establish base behaviour - ok( $decoder->decode($encoder->encode("foo")), 'normal decode' ); + ok( $decoder->decode( $encoder->encode("foo") ), 'normal decode' ); # build test string with data after first document my $str; - foreach my $i (0..1) { + foreach my $i ( 0 .. 1 ) { $str .= $encoder->encode("foo"); } - ok( _decode_with_offset($str, $decoder), 'decode with offset' ); + ok( _decode_with_offset( $str, $decoder ), 'decode with offset' ); } -} # end SKIP block +} # end SKIP block sub _decode_with_offset { - my ($value, $decoder) = @_; + my ( $value, $decoder )= @_; my @decoded_values; - my $pos = 0; + my $pos= 0; + #my $first = index($value, "=srl", 1); #$value = substr($value, 0, $first); - my $ok = eval { - while ($pos < length($value)) { - push @decoded_values, $decoder->decode_with_offset($value, $pos); + my $ok= eval { + while ( $pos < length($value) ) { + push @decoded_values, $decoder->decode_with_offset( $value, $pos ); last if $decoder->bytes_consumed == 0; $pos += $decoder->bytes_consumed; } 1; }; - my $err = $@; - ok($ok, "decoding did not die") + my $err= $@; + ok( $ok, "decoding did not die" ) or diag("Exception: $err"), return; return \@decoded_values; diff -Nru libsereal-perl-4.007/t/901_regr_segv.t libsereal-perl-4.011/t/901_regr_segv.t --- libsereal-perl-4.007/t/901_regr_segv.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/901_regr_segv.t 2020-02-02 17:25:40.000000000 +0000 @@ -4,6 +4,7 @@ use Test::More; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -14,9 +15,15 @@ use Test::Warn; SCOPE: { - my $d = Sereal::Decoder->new; - warnings_are { eval {$d->decode("=srl\1\0\321j\3\3\3\3\3\3\3\3\3\3.\1")} } [], "no warnings"; - warnings_are { eval {$d->decode("=srl\1\0\254/\6")} } [], "no warnings"; + my $d= Sereal::Decoder->new; + warnings_are { + eval { $d->decode("=srl\1\0\321j\3\3\3\3\3\3\3\3\3\3.\1") } + } + [], "no warnings"; + warnings_are { + eval { $d->decode("=srl\1\0\254/\6") } + } + [], "no warnings"; } pass("Alive"); diff -Nru libsereal-perl-4.007/t/902_bad_input.t libsereal-perl-4.011/t/902_bad_input.t --- libsereal-perl-4.007/t/902_bad_input.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/902_bad_input.t 2020-02-02 17:25:40.000000000 +0000 @@ -3,6 +3,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -13,11 +14,14 @@ use Sereal::Decoder qw(decode_sereal); use Sereal::Decoder::Constants qw(:all); -for my $ref (\"", [], {}, \*STDERR) { +for my $ref ( \"", [], {}, \*STDERR ) { eval { decode_sereal($ref); 1; } or do { - like($@, qr/We can't decode a reference as Sereal!/, "We'll die on " . ref($ref) . " references"); + like( + $@, qr/We can't decode a reference as Sereal!/, + "We'll die on " . ref($ref) . " references" + ); }; } diff -Nru libsereal-perl-4.007/t/903_reentrancy.t libsereal-perl-4.011/t/903_reentrancy.t --- libsereal-perl-4.007/t/903_reentrancy.t 2018-03-21 10:49:08.000000000 +0000 +++ libsereal-perl-4.011/t/903_reentrancy.t 2020-02-02 17:25:40.000000000 +0000 @@ -2,6 +2,7 @@ use warnings; use File::Spec; use lib File::Spec->catdir(qw(t lib)); + BEGIN { lib->import('lib') if !-d 't'; @@ -16,32 +17,33 @@ # Decoder is (was) not re-entrant. my $dec; + package Foo; -sub FREEZE { my $x = Sereal::Encoder->new->encode($_[0]->{a}); return $x; } -sub THAW { bless({a => $dec->decode($_[2])}, $_[0]) } +sub FREEZE { my $x= Sereal::Encoder->new->encode( $_[0]->{a} ); return $x; } +sub THAW { bless( { a => $dec->decode( $_[2] ) }, $_[0] ) } package main; SKIP: { - my $have_enc = have_encoder_and_decoder(); - if (not $have_enc) { + my $have_enc= have_encoder_and_decoder(); + if ( not $have_enc ) { skip "Need encoder for Snappy regression tests", 2; } else { - $dec = Sereal::Decoder->new; - my $z = [ bless({a=>42},"Foo") ]; + $dec= Sereal::Decoder->new; + my $z= [ bless( { a => 42 }, "Foo" ) ]; push @$z, $z; - my $a = Sereal::Encoder->new({freeze_callbacks=>1})->encode($z); + my $a= Sereal::Encoder->new( { freeze_callbacks => 1 } )->encode($z); my $b; my $err; eval { - $b = $dec->decode($a); - 1 + $b= $dec->decode($a); + 1; } or do { - $err = $@ || 'Zombie error'; + $err= $@ || 'Zombie error'; }; - ok(!$err, "Decoding did not barf") + ok( !$err, "Decoding did not barf" ) or diag("Decoding barfed with '$err'"); - is_deeply($b, $z, "Output from decoding is correct"); + is_deeply( $b, $z, "Output from decoding is correct" ); } } diff -Nru libsereal-perl-4.007/t/lib/Sereal/BulkTest.pm libsereal-perl-4.011/t/lib/Sereal/BulkTest.pm --- libsereal-perl-4.007/t/lib/Sereal/BulkTest.pm 2017-11-12 19:23:37.000000000 +0000 +++ libsereal-perl-4.011/t/lib/Sereal/BulkTest.pm 2020-02-02 17:25:40.000000000 +0000 @@ -1,4 +1,4 @@ -package # hide from PAUSE +package # hide from PAUSE Sereal::BulkTest; use strict; @@ -9,17 +9,18 @@ use Test::LongString; use Exporter; -our @ISA = qw(Exporter); -our @EXPORT_OK = qw(run_bulk_tests); -our %EXPORT_TAGS = ('all' => \@EXPORT_OK); +our @ISA= qw(Exporter); +our @EXPORT_OK= qw(run_bulk_tests); +our %EXPORT_TAGS= ( 'all' => \@EXPORT_OK ); use Sereal::TestSet qw(:all); our $HAVE_JSON_XS; our $CORPUS; + BEGIN { $HAVE_JSON_XS= eval "use JSON::XS; 1"; - $CORPUS||= $ENV{CORPUS} || File::Spec->catfile(qw(t data corpus)); + $CORPUS ||= $ENV{CORPUS} || File::Spec->catfile(qw(t data corpus)); } my @corpus; @@ -28,12 +29,12 @@ my @raw_corpus; sub read_files { - my ($sub, $what)= @_; - if (!@corpus) { + my ( $sub, $what )= @_; + if ( !@corpus ) { note("Reading"); open my $fh, "<", $CORPUS or die "Failed to read '$CORPUS': $!"; - local $/="\n---\n"; + local $/= "\n---\n"; while (<$fh>) { chomp; my $VAR1; @@ -42,7 +43,7 @@ die $@ if $@; warn "SRC=$_\n\nRES=$res\n\n" if not ref $res; - push @corpus, $res; + push @corpus, $res; push @sereal_corpus, Sereal::Encoder::encode_sereal($res); if ($HAVE_JSON_XS) { push @js_corpus, JSON::XS::encode_json($res); @@ -51,18 +52,18 @@ close $fh; } my $corpus; - $what = '' if not defined $what; - if ($what =~ /json/i) { - $corpus = \@js_corpus; + $what= '' if not defined $what; + if ( $what =~ /json/i ) { + $corpus= \@js_corpus; } - elsif ($what =~ /sereal/i) { - $corpus = \@sereal_corpus; + elsif ( $what =~ /sereal/i ) { + $corpus= \@sereal_corpus; } - elsif ($what =~ /raw/i) { - $corpus = \@raw_corpus; + elsif ( $what =~ /raw/i ) { + $corpus= \@raw_corpus; } else { - $corpus = \@corpus; + $corpus= \@corpus; } my $count= 0; @@ -71,44 +72,46 @@ } return $count; } + #use Devel::Peek; sub run_bulk_tests { - my %opt = @_; + my %opt= @_; - if (not $opt{bench}) { - my $total= read_files(sub { return 1 }); + if ( not $opt{bench} ) { + my $total= read_files( sub { return 1 } ); my $read= 0; - my $eval_ok= read_files(sub { - my $struct= $_[0]; - diag("read $read\n") unless ++$read % 1000; - my ($dump, $undump); - my $ok= eval { - $dump = Sereal::Encoder::encode_sereal($_[0]); - $undump= Sereal::Decoder::decode_sereal($dump, $opt{decoder_options} || {}); - 1; - }; - my $err = $@ || 'Zombie error'; - ok($ok,"Error return is empty") - or diag("Error was: '$err'"), return $ok; - if ($ok and ref($struct) eq "HASH") { - my $each_count= 0; - - $each_count++ while my($k,$v)= each %$undump; - - my $keys_count= 0 + keys %$struct; - is($each_count,$keys_count,"Number of keys match"); - } - - my $struct_dd= Data::Dumper->new([ $struct ])->Sortkeys(1)->Dump(); - my $undump_dd= Data::Dumper->new([ $undump ])->Sortkeys(1)->Dump(); - $ok= is_string($undump_dd, $struct_dd) - or diag $struct_dd; - return $ok; - }); - is($total,$eval_ok); + my $eval_ok= read_files( + sub { + my $struct= $_[0]; + diag("read $read\n") unless ++$read % 1000; + my ( $dump, $undump ); + my $ok= eval { + $dump= Sereal::Encoder::encode_sereal( $_[0] ); + $undump= Sereal::Decoder::decode_sereal( $dump, $opt{decoder_options} || {} ); + 1; + }; + my $err= $@ || 'Zombie error'; + ok( $ok, "Error return is empty" ) + or diag("Error was: '$err'"), return $ok; + if ( $ok and ref($struct) eq "HASH" ) { + my $each_count= 0; + + $each_count++ while my ( $k, $v )= each %$undump; + + my $keys_count= 0 + keys %$struct; + is( $each_count, $keys_count, "Number of keys match" ); + } + + my $struct_dd= Data::Dumper->new( [$struct] )->Sortkeys(1)->Dump(); + my $undump_dd= Data::Dumper->new( [$undump] )->Sortkeys(1)->Dump(); + $ok= is_string( $undump_dd, $struct_dd ) + or diag $struct_dd; + return $ok; + } ); + is( $total, $eval_ok ); } - if ($opt{bench}) { + if ( $opt{bench} ) { require Benchmark; require Time::HiRes; Benchmark->import(qw(:hireswallclock)); @@ -116,27 +119,32 @@ -3, { 'noop' => sub { - read_files(sub{return 1}) + read_files( sub { return 1 } ); }, - 'decode_sereal' => sub{ - read_files(sub { return( decode_sereal($_[0], $opt{decoder_options} || {} ) ); }, 'sereal') + 'decode_sereal' => sub { + read_files( + sub { return ( decode_sereal( $_[0], $opt{decoder_options} || {} ) ); }, + 'sereal' + ); }, - 'eval' => sub{ - read_files(sub { return( eval $_[0] ); }, 'raw') + 'eval' => sub { + read_files( sub { return ( eval $_[0] ); }, 'raw' ); }, - do {eval "require Data::Undump"} ? ( - 'undump' => sub{ - read_files(sub { return( Data::Undump::undump($_[0]) ); }, 'raw') + do { eval "require Data::Undump" } + ? ( + 'undump' => sub { + read_files( sub { return ( Data::Undump::undump( $_[0] ) ); }, 'raw' ); }, - ): (), - $HAVE_JSON_XS ? ( + ) + : (), + $HAVE_JSON_XS + ? ( 'decode_json' => sub { - read_files(sub { return decode_json($_[0]) }, 'json'), - } - ) : (), - } - ); - note join "\n","", map {sprintf"%-20s" . (" %20s" x (@$_-1)), @$_ } @$result; + read_files( sub { return decode_json( $_[0] ) }, 'json' ),; + } ) + : (), + } ); + note join "\n", "", map { sprintf "%-20s" . ( " %20s" x ( @$_ - 1 ) ), @$_ } @$result; } } 1; diff -Nru libsereal-perl-4.007/t/lib/Sereal/TestSet.pm libsereal-perl-4.011/t/lib/Sereal/TestSet.pm --- libsereal-perl-4.007/t/lib/Sereal/TestSet.pm 2018-01-23 20:18:12.000000000 +0000 +++ libsereal-perl-4.011/t/lib/Sereal/TestSet.pm 2020-02-02 17:25:40.000000000 +0000 @@ -1,4 +1,4 @@ -package # Hide from PAUSE +package # Hide from PAUSE Sereal::TestSet; use strict; @@ -8,6 +8,7 @@ use Scalar::Util qw(weaken); use Test::More; use Test::LongString; + #use Data::Dumper; # MUST BE LOADED *AFTER* THIS FILE (BUG IN PERL) use Devel::Peek; use Encode qw(encode_utf8 is_utf8); @@ -18,59 +19,62 @@ use Cwd; # Dynamically load constants from whatever is being tested -our ($Class, $ConstClass, $InRepo); +our ( $Class, $ConstClass, $InRepo ); + sub get_git_top_dir { - my @dirs = (0, 1, 2, 4); + my @dirs= ( 0, 1, 2, 4 ); for my $d (@dirs) { - my $tdir = File::Spec->catdir(map File::Spec->updir, 1..$d); - my $gdir = File::Spec->catdir($tdir, '.git'); + my $tdir= File::Spec->catdir( map File::Spec->updir, 1 .. $d ); + my $gdir= File::Spec->catdir( $tdir, '.git' ); return $tdir if -d $gdir; } - return(); + return (); } -BEGIN{ - if (defined(my $top_dir = get_git_top_dir())) { - for my $need ('Encoder', 'Decoder') { - my $blib_dir = File::Spec->catdir($top_dir, 'Perl', $need, "blib"); - if (-d $blib_dir) { +BEGIN { + if ( defined( my $top_dir= get_git_top_dir() ) ) { + for my $need ( 'Encoder', 'Decoder' ) { + my $blib_dir= File::Spec->catdir( $top_dir, 'Perl', $need, "blib" ); + if ( -d $blib_dir ) { require blib; blib->import($blib_dir); } } - $InRepo=1; + $InRepo= 1; } } + BEGIN { - if (-e "lib/Sereal.pm") { - $Class = 'Sereal::Encoder'; + if ( -e "lib/Sereal.pm" ) { + $Class= 'Sereal::Encoder'; + } + elsif ( -e "lib/Sereal/Encoder.pm" ) { + $Class= 'Sereal::Encoder'; } - elsif (-e "lib/Sereal/Encoder.pm") { - $Class = 'Sereal::Encoder'; + elsif ( -e "lib/Sereal/Decoder.pm" ) { + $Class= 'Sereal::Decoder'; } - elsif (-e "lib/Sereal/Decoder.pm") { - $Class = 'Sereal::Decoder'; + elsif ( -e "lib/Sereal/Merger.pm" ) { + $Class= 'Sereal::Merger'; } - elsif (-e "lib/Sereal/Merger.pm") { - $Class = 'Sereal::Merger'; + elsif ( -e "lib/Sereal/Splitter.pm" ) { + $Class= 'Sereal::Splitter'; } - elsif (-e "lib/Sereal/Splitter.pm") { - $Class = 'Sereal::Splitter'; - } else { - die "Could not find an applicable Sereal constants location (in: ",cwd(),")"; + else { + die "Could not find an applicable Sereal constants location (in: ", cwd(), ")"; } - $ConstClass = $Class . "::Constants"; + $ConstClass= $Class . "::Constants"; eval "use $ConstClass ':all'; 1" - or do { - my $err = $@ || 'Zombie Error'; + or do { + my $err= $@ || 'Zombie Error'; die "Failed to load/import constants from '$ConstClass': $err"; - }; + }; } use Exporter; -our @ISA = qw(Exporter); -our @EXPORT_OK = qw( +our @ISA= qw(Exporter); +our @EXPORT_OK= qw( @BasicTests $Class $ConstClass Header TRACK_FLAG @@ -87,105 +91,108 @@ _cmp_str ); -our %EXPORT_TAGS = (all => \@EXPORT_OK); -our $use_objectv = 1; +our %EXPORT_TAGS= ( all => \@EXPORT_OK ); +our $use_objectv= 1; use constant TRACK_FLAG => 128; sub hobodecode { return unless defined $_[0]; - open my $fh, "| $^X -Mblib=../Encoder -Mblib=../Decoder author_tools/hobodecoder.pl -e" or die $!; + open my $fh, "| $^X -Mblib=../Encoder -Mblib=../Decoder author_tools/hobodecoder.pl -e" + or die $!; print $fh $_[0]; close $fh; } sub array_head { - if ($_[0]>=16) { - return chr(SRL_HDR_REFN) . chr(SRL_HDR_ARRAY) . varint($_[0]) - } else { - return chr(SRL_HDR_ARRAYREF + $_[0]) + if ( $_[0] >= 16 ) { + return chr(SRL_HDR_REFN) . chr(SRL_HDR_ARRAY) . varint( $_[0] ); + } + else { + return chr( SRL_HDR_ARRAYREF + $_[0] ); } } + sub array { - array_head( 0+@_ ) . join("", @_) + array_head( 0 + @_ ) . join( "", @_ ); } sub array_fbit { - chr(SRL_HDR_REFN). - chr(SRL_HDR_ARRAY+TRACK_FLAG) . varint(0+@_) . join("", @_) + chr(SRL_HDR_REFN) . chr( SRL_HDR_ARRAY +TRACK_FLAG ) . varint( 0 + @_ ) . join( "", @_ ); } sub hash_head { my $ret; - my $len= int $_[0]/2; - if ($len >= 16) { - return chr(SRL_HDR_REFN) . chr(SRL_HDR_HASH) . varint($len) - } else { - return chr(SRL_HDR_HASHREF + $len) + my $len= int $_[0] / 2; + if ( $len >= 16 ) { + return chr(SRL_HDR_REFN) . chr(SRL_HDR_HASH) . varint($len); + } + else { + return chr( SRL_HDR_HASHREF + $len ); } } + sub hash { - hash_head(0+@_) . join("", @_) + hash_head( 0 + @_ ) . join( "", @_ ); } sub dump_bless { + # this hack does not support UTF8 class names, but that's not supported by # most releases of perl anyway ( - ref($_[1]) + ref( $_[1] ) ? ( - $use_objectv - ? chr(SRL_HDR_OBJECTV) . varint(${$_[1]}) - : chr(SRL_HDR_OBJECT) . chr(SRL_HDR_COPY) . varint(${$_[1]}) - ) - : - chr(SRL_HDR_OBJECT). - ( - (length($_[1]) >= SRL_MASK_SHORT_BINARY_LEN) - ? chr(SRL_HDR_BINARY).varint(length($_[1])).$_[1] - : chr(length($_[1]) + SRL_HDR_SHORT_BINARY_LOW).$_[1] - ) - ) - . $_[0] + $use_objectv + ? chr(SRL_HDR_OBJECTV) . varint( ${ $_[1] } ) + : chr(SRL_HDR_OBJECT) . chr(SRL_HDR_COPY) . varint( ${ $_[1] } ) ) + : chr(SRL_HDR_OBJECT) + . ( + ( length( $_[1] ) >= SRL_MASK_SHORT_BINARY_LEN ) + ? chr(SRL_HDR_BINARY) . varint( length( $_[1] ) ) . $_[1] + : chr( length( $_[1] ) + SRL_HDR_SHORT_BINARY_LOW ) . $_[1] ) ) . $_[0]; } sub short_string { - my ($str, $alias)= @_; + my ( $str, $alias )= @_; $alias ||= 0; my $length= length($str); - if ($length > SRL_MASK_SHORT_BINARY_LEN) { + if ( $length > SRL_MASK_SHORT_BINARY_LEN ) { confess "String too long for short_string(), alias=$alias length=$length"; } - my $tag = SRL_HDR_SHORT_BINARY_LOW + length($str); - if ($tag > SRL_HDR_SHORT_BINARY_HIGH) { - confess "Tag value larger than SRL_HDR_SHORT_BINARY_HIGH, tag=$tag; alias=$alias; length=$length"; + my $tag= SRL_HDR_SHORT_BINARY_LOW + length($str); + if ( $tag > SRL_HDR_SHORT_BINARY_HIGH ) { + confess + "Tag value larger than SRL_HDR_SHORT_BINARY_HIGH, tag=$tag; alias=$alias; length=$length"; } $tag |= SRL_HDR_TRACK_FLAG if $alias; - if ($tag > 255) { - confess "Tag value over 255 in short_string(), tag=$tag; alias=$alias; length=$length; SRL_HDR_TRACK_FLAG=", SRL_HDR_TRACK_FLAG; + if ( $tag > 255 ) { + confess + "Tag value over 255 in short_string(), tag=$tag; alias=$alias; length=$length; SRL_HDR_TRACK_FLAG=", + SRL_HDR_TRACK_FLAG; } return chr($tag) . $str; } sub integer { - if ($_[0] < 0) { + if ( $_[0] < 0 ) { return $_[0] < -16 - ? die("zigzag not implemented in test suite") - : chr(0b0001_0000 + abs($_[0])); + ? die("zigzag not implemented in test suite") + : chr( 0b0001_0000 + abs( $_[0] ) ); } else { return $_[0] > 15 - ? varint($_[0]) - : chr(0b0000_0000 + $_[0]); + ? varint( $_[0] ) + : chr( 0b0000_0000 + $_[0] ); } } sub varint { - my $n = shift; + my $n= shift; die "varint cannot be negative" if $n < 0; - my $out = ''; - while ($n >= 0x80) { - $out .= chr( ($n & 0x7f) | 0x80 ); + my $out= ''; + while ( $n >= 0x80 ) { + $out .= chr( ( $n & 0x7f ) | 0x80 ); $n >>= 7; } $out .= chr($n); @@ -195,12 +202,12 @@ our $PROTO_VERSION; sub Header { - my $proto_version = shift || $PROTO_VERSION || SRL_PROTOCOL_VERSION; - my $user_data_blob = shift; - my $mgc = $proto_version > 2 ? SRL_MAGIC_STRING_HIGHBIT : SRL_MAGIC_STRING; - my $hdr_base = $mgc . chr($proto_version); - if (defined $user_data_blob) { - return $hdr_base . varint(1 + length($user_data_blob)) . chr(1) . $user_data_blob; + my $proto_version= shift || $PROTO_VERSION || SRL_PROTOCOL_VERSION; + my $user_data_blob= shift; + my $mgc= $proto_version > 2 ? SRL_MAGIC_STRING_HIGHBIT : SRL_MAGIC_STRING; + my $hdr_base= $mgc . chr($proto_version); + if ( defined $user_data_blob ) { + return $hdr_base . varint( 1 + length($user_data_blob) ) . chr(1) . $user_data_blob; } else { return $hdr_base . chr(0); @@ -210,18 +217,20 @@ sub offset { my ($str)= @_; Carp::confess("no protoversion") if !defined $PROTO_VERSION; - if ($PROTO_VERSION >= 2) { - return length($str)+1; - } else { + if ( $PROTO_VERSION >= 2 ) { + return length($str) + 1; + } + else { return length($str) + length Header($PROTO_VERSION); } } sub offseti { - my ( $i )= @_; - if ($PROTO_VERSION >= 2) { + my ($i)= @_; + if ( $PROTO_VERSION >= 2 ) { return $i + 1; - } else { + } + else { return $i + length Header($PROTO_VERSION); } } @@ -230,289 +239,328 @@ return [] unless @_; my $vals= shift; my @rest= _permute(@_); - map { my $v= $_; map { [ $v, @$_ ] } @rest } @$vals; + map { + my $v= $_; + map { [ $v, @$_ ] } + @rest + } @$vals; } sub permute_array { - map { array(@$_) } _permute(@_); + map { array(@$_) } _permute(@_); } sub debug_checks { - my ($data_ref, $encoded_ref, $decoded_ref, $debug) = @_; - if ($debug or defined $ENV{DEBUG_SEREAL}) { + my ( $data_ref, $encoded_ref, $decoded_ref, $debug )= @_; + if ( $debug or defined $ENV{DEBUG_SEREAL} ) { require Data::Dumper; - note("Original data was: " . Data::Dumper::Dumper($$data_ref)) + note( "Original data was: " . Data::Dumper::Dumper($$data_ref) ) if defined $data_ref; - note("Encoded data is: " . (defined($$encoded_ref) ? Data::Dumper::qquote($$encoded_ref) : "")) + note( "Encoded data is: " + . ( defined($$encoded_ref) ? Data::Dumper::qquote($$encoded_ref) : "" ) ) if defined $encoded_ref; - note("Decoded data was: " . Data::Dumper::Dumper($$decoded_ref)) + note( "Decoded data was: " . Data::Dumper::Dumper($$decoded_ref) ) if defined $decoded_ref; } - if (defined $ENV{DEBUG_DUMP}) { + if ( defined $ENV{DEBUG_DUMP} ) { Dump($$data_ref) if defined $data_ref; Dump($$encoded_ref) if defined $encoded_ref; Dump($$decoded_ref) if defined $decoded_ref; } - if (defined $ENV{DEBUG_HOBO}) { + if ( defined $ENV{DEBUG_HOBO} ) { hobodecode($$encoded_ref) if defined $encoded_ref; } exit() if $ENV{DEBUG_FAIL_FATAL}; } our @BasicTests; + sub setup_tests { - my ($proto_version)=@_; + my ($proto_version)= @_; $PROTO_VERSION= $proto_version if defined $proto_version; - my $ary_ref_for_repeating = [5,6]; - my $scalar_ref_for_repeating = \9; + my $ary_ref_for_repeating= [ 5, 6 ]; + my $scalar_ref_for_repeating= \9; - my $weak_thing; $weak_thing = [\$weak_thing, 1]; weaken($weak_thing->[0]); + my $weak_thing; $weak_thing= [ \$weak_thing, 1 ]; weaken( $weak_thing->[0] ); - my $unicode1= "Ba\xDF Ba\xDF"; my $unicode2= "\x{168}nix! \x{263a}"; utf8::upgrade($unicode1); utf8::upgrade($unicode2); + my $unicode1= "Ba\xDF Ba\xDF"; my $unicode2= "\x{168}nix! \x{263a}"; utf8::upgrade($unicode1); + utf8::upgrade($unicode2); # each test is an array: # index 0 is the input to the encoder # index 1 is the output *without* header - or a sub which returns an expected output # index 2 is the name of the test # index 3 and on are alternate outputs (or subs which return alternate output(s)) - @BasicTests = ( + @BasicTests= ( + # warning: this hardcodes the POS/NEG headers - [-16, chr(0b0001_0000), "encode -16"], - [-1, chr(0b0001_1111), "encode -1"], - [0, chr(0b0000_0000), "encode 0"], - [1, chr(0b0000_0001), "encode 1"], - [15, chr(0b0000_1111), "encode 15"], - [undef, chr(SRL_HDR_UNDEF), "encode undef"], - ["", short_string(""), "encode empty string"], - ["1", short_string("1"), "encode string '1'"], - ["91a", short_string("91a"), "encode string '91a'"], - ["abc" x 1000, chr(SRL_HDR_BINARY).varint(3000).("abc" x 1000), "long ASCII string"], - [\1, chr(SRL_HDR_REFN).chr(0b0000_0001), "scalar ref to int"], - [[], array(), "empty array ref"], - [[1,2,3], array(chr(0b0000_0001), chr(0b0000_0010), chr(0b0000_0011)), "array ref"], - [1000, chr(SRL_HDR_VARINT).varint(1000), "large int"], - [ [ map { $_, undef } 1..1000 ], + [ -16, chr(0b0001_0000), "encode -16" ], + [ -1, chr(0b0001_1111), "encode -1" ], + [ 0, chr(0b0000_0000), "encode 0" ], + [ 1, chr(0b0000_0001), "encode 1" ], + [ 15, chr(0b0000_1111), "encode 15" ], + [ undef, chr(SRL_HDR_UNDEF), "encode undef" ], + [ "", short_string(""), "encode empty string" ], + [ "1", short_string("1"), "encode string '1'" ], + [ "91a", short_string("91a"), "encode string '91a'" ], + [ + "abc" x 1000, chr(SRL_HDR_BINARY) . varint(3000) . ( "abc" x 1000 ), "long ASCII string" + ], + [ \1, chr(SRL_HDR_REFN) . chr(0b0000_0001), "scalar ref to int" ], + [ [], array(), "empty array ref" ], + [ [ 1, 2, 3 ], array( chr(0b0000_0001), chr(0b0000_0010), chr(0b0000_0011) ), "array ref" ], + [ 1000, chr(SRL_HDR_VARINT) . varint(1000), "large int" ], + [ + [ map { $_, undef } 1 .. 1000 ], array( - (map { chr($_) => chr(SRL_HDR_UNDEF) } (1 .. SRL_POS_MAX_SIZE)), - (map { chr(SRL_HDR_VARINT) . varint($_) => chr(SRL_HDR_UNDEF) } ((SRL_POS_MAX_SIZE+1) .. 1000)) + ( map { chr($_) => chr(SRL_HDR_UNDEF) } ( 1 .. SRL_POS_MAX_SIZE ) ), + ( + map { chr(SRL_HDR_VARINT) . varint($_) => chr(SRL_HDR_UNDEF) } + ( ( SRL_POS_MAX_SIZE + 1 ) .. 1000 ) ) ), "array ref with pos and varints and undef" ], - [{}, hash(), "empty hash ref"], - [{foo => "baaaaar"}, hash(short_string("foo"),short_string("baaaaar")), "simple hash ref"], + [ {}, hash(), "empty hash ref" ], + [ + { foo => "baaaaar" }, hash( short_string("foo"), short_string("baaaaar") ), + "simple hash ref" + ], + [ + [qw(foooo foooo foooo)], + sub { + my $opt= shift; + if ( $opt->{dedupe_strings} || $opt->{aliased_dedupe_strings} ) { + my $d= array_head(3); + my $pos= offset($d); + my $tag= $opt->{aliased_dedupe_strings} ? SRL_HDR_ALIAS : SRL_HDR_COPY; + $d .= + short_string( "foooo", $opt->{aliased_dedupe_strings} ? 1 : 0 ) + . chr($tag) + . varint($pos) + . chr($tag) + . varint($pos); + return $d; + } + else { + return array( + short_string("foooo"), short_string("foooo"), + short_string("foooo") ); + } + }, + "ary ref with repeated string" + ], [ - [qw(foooo foooo foooo)], - sub { - my $opt = shift; - if ($opt->{dedupe_strings} || $opt->{aliased_dedupe_strings}) { - my $d = array_head(3); - my $pos = offset($d); - my $tag = $opt->{aliased_dedupe_strings} ? SRL_HDR_ALIAS : SRL_HDR_COPY; - $d .= short_string("foooo",$opt->{aliased_dedupe_strings} ? 1 : 0) . chr($tag) . varint($pos) - . chr($tag) . varint($pos); - return $d; - } - else { - return array(short_string("foooo"),short_string("foooo"), short_string("foooo")); - } - }, - "ary ref with repeated string" - ], - [ - [{foooo => "barrr"}, {barrr => "foooo"}], - array(hash(short_string("foooo"), short_string("barrr")), - hash(short_string("barrr"), short_string("foooo"))), - "ary ref of hash refs without repeated strings" - ], - [ - [{foooo => "foooo"}, {foooo2 => "foooo"}], - sub { - my $opt = shift; - if ($opt->{dedupe_strings} || $opt->{aliased_dedupe_strings}) { - my $tag = $opt->{aliased_dedupe_strings} ? SRL_HDR_ALIAS : SRL_HDR_COPY; - my $d = array_head(2) . hash_head(2) . short_string("foooo"); - my $pos = offset($d); - $d .= short_string("foooo",$opt->{aliased_dedupe_strings} ? 1 : 0) . hash_head(2) + [ { foooo => "barrr" }, { barrr => "foooo" } ], + array( + hash( short_string("foooo"), short_string("barrr") ), + hash( short_string("barrr"), short_string("foooo") ) + ), + "ary ref of hash refs without repeated strings" + ], + [ + [ { foooo => "foooo" }, { foooo2 => "foooo" } ], + sub { + my $opt= shift; + if ( $opt->{dedupe_strings} || $opt->{aliased_dedupe_strings} ) { + my $tag= $opt->{aliased_dedupe_strings} ? SRL_HDR_ALIAS : SRL_HDR_COPY; + my $d= array_head(2) . hash_head(2) . short_string("foooo"); + my $pos= offset($d); + $d .= + short_string( "foooo", $opt->{aliased_dedupe_strings} ? 1 : 0 ) + . hash_head(2) . short_string("foooo2") - . chr($tag) . varint($pos); - return $d; - } - else { - return array(hash(short_string("foooo"), short_string("foooo")), - hash(short_string("foooo2"), short_string("foooo"))), - } - }, - "ary ref of hash refs with repeated strings" + . chr($tag) + . varint($pos); + return $d; + } + else { + return array( + hash( short_string("foooo"), short_string("foooo") ), + hash( short_string("foooo2"), short_string("foooo") ) + ), + ; + } + }, + "ary ref of hash refs with repeated strings" + ], + [ + $scalar_ref_for_repeating, chr(SRL_HDR_REFN) . chr(0b0000_1001), + "scalar ref to constant" ], - [$scalar_ref_for_repeating, chr(SRL_HDR_REFN).chr(0b0000_1001), "scalar ref to constant"], - [[$scalar_ref_for_repeating, $scalar_ref_for_repeating], + [ + [ $scalar_ref_for_repeating, $scalar_ref_for_repeating ], do { - my $content = array_head(2); - $content .= chr(SRL_HDR_REFN); - my $pos = offset($content); - $content .= chr(0b1000_1001) - .chr(SRL_HDR_REFP) - .varint($pos) - ; - $content - }, "repeated substructure (REFP): scalar ref"], - [[$ary_ref_for_repeating, $ary_ref_for_repeating], + my $content= array_head(2); + $content .= chr(SRL_HDR_REFN); + my $pos= offset($content); + $content .= chr(0b1000_1001) . chr(SRL_HDR_REFP) . varint($pos); + $content; + }, + "repeated substructure (REFP): scalar ref" + ], + [ + [ $ary_ref_for_repeating, $ary_ref_for_repeating ], do { - my $content = array_head(2); - my $pos = offset($content) + 1; - $content .= array_fbit(chr(0b0000_0101), chr(0b0000_0110)) - .chr(SRL_HDR_REFP) - .varint($pos) - ; - $content - }, "repeated substructure (REFP): array"], - [[\$ary_ref_for_repeating, [1, $ary_ref_for_repeating]], + my $content= array_head(2); + my $pos= offset($content) + 1; + $content .= + array_fbit( chr(0b0000_0101), chr(0b0000_0110) ) + . chr(SRL_HDR_REFP) + . varint($pos); + $content; + }, + "repeated substructure (REFP): array" + ], + [ + [ \$ary_ref_for_repeating, [ 1, $ary_ref_for_repeating ] ], do { - my $content = array_head(2) . chr(SRL_HDR_REFN); - my $pos = offset($content) + 1; + my $content= array_head(2) . chr(SRL_HDR_REFN); + my $pos= offset($content) + 1; $content .= array_fbit( - chr(0b0000_0101), - chr(0b0000_0110) - ) - . array( - chr(0b0000_0001), - chr(SRL_HDR_REFP) . varint($pos) - ) - ; - $content - }, "repeated substructure (REFP): asymmetric"], + chr(0b0000_0101), + chr(0b0000_0110) ) + . array( + chr(0b0000_0001), + chr(SRL_HDR_REFP) . varint($pos) ); + $content; + }, + "repeated substructure (REFP): asymmetric" + ], [ $weak_thing, - chr(SRL_HDR_REFN) - . chr(SRL_HDR_ARRAY + TRACK_FLAG) . varint(2) - . chr(SRL_HDR_PAD) . chr(SRL_HDR_REFN) - . chr(SRL_HDR_REFP) . varint(offseti(1)) - . chr(0b0000_0001) - , + chr(SRL_HDR_REFN) + . chr( SRL_HDR_ARRAY + TRACK_FLAG ) + . varint(2) + . chr(SRL_HDR_PAD) + . chr(SRL_HDR_REFN) + . chr(SRL_HDR_REFP) + . varint( offseti(1) ) + . chr(0b0000_0001), "weak thing copy (requires PAD)" ], [ \$weak_thing, chr(SRL_HDR_REFN) - . chr(SRL_HDR_REFN + TRACK_FLAG) - . chr(SRL_HDR_ARRAY) . varint(2) - .chr(SRL_HDR_WEAKEN) . chr(SRL_HDR_REFP) . varint(offseti(1)) - .chr(0b0000_0001) - , + . chr( SRL_HDR_REFN + TRACK_FLAG ) + . chr(SRL_HDR_ARRAY) + . varint(2) + . chr(SRL_HDR_WEAKEN) + . chr(SRL_HDR_REFP) + . varint( offseti(1) ) + . chr(0b0000_0001), "weak thing ref" ], - sub { \@_ } ->( + sub { \@_ } + ->( $weak_thing, - chr(SRL_HDR_REFN + TRACK_FLAG) - .chr(SRL_HDR_ARRAY).varint(2) - .chr(SRL_HDR_WEAKEN).chr(SRL_HDR_REFP).varint(offseti(0)) - .chr(0b0000_0001) - , + chr( SRL_HDR_REFN + TRACK_FLAG ) + . chr(SRL_HDR_ARRAY) + . varint(2) + . chr(SRL_HDR_WEAKEN) + . chr(SRL_HDR_REFP) + . varint( offseti(0) ) + . chr(0b0000_0001), "weak thing (aliased root)" - ), + ), [ - do { my @array; $array[0]=\$array[1]; $array[1]=\$array[0]; \@array }, + do { my @array; $array[0]= \$array[1]; $array[1]= \$array[0]; \@array }, do { my $content= array_head(2); my $pos= offset($content); $content - . chr(SRL_HDR_REFN + TRACK_FLAG) - . chr(SRL_HDR_REFP + TRACK_FLAG) - . varint( $pos ) - . chr(SRL_HDR_ALIAS) - . varint($pos + 1) + . chr( SRL_HDR_REFN + TRACK_FLAG ) + . chr( SRL_HDR_REFP + TRACK_FLAG ) + . varint($pos) + . chr(SRL_HDR_ALIAS) + . varint( $pos + 1 ); }, "scalar cross" ], [ - do { my @array; $array[0]=\$array[1]; $array[1]=\$array[0]; weaken($array[1]); weaken($array[0]); \@array }, + do { + my @array; $array[0]= \$array[1]; $array[1]= \$array[0]; weaken( $array[1] ); + weaken( $array[0] ); \@array; + }, do { my $content= array_head(2); my $pos= offset($content); $content - . chr(SRL_HDR_WEAKEN + TRACK_FLAG) - . chr(SRL_HDR_REFN) - . chr(SRL_HDR_WEAKEN + TRACK_FLAG) - . chr(SRL_HDR_REFP) - . varint($pos) - . chr(SRL_HDR_ALIAS) - . varint($pos+2) + . chr( SRL_HDR_WEAKEN + TRACK_FLAG ) + . chr(SRL_HDR_REFN) + . chr( SRL_HDR_WEAKEN + TRACK_FLAG ) + . chr(SRL_HDR_REFP) + . varint($pos) + . chr(SRL_HDR_ALIAS) + . varint( $pos + 2 ); }, "weak scalar cross" ], [ - bless([],"foo"), - dump_bless(array(), "foo"), + bless( [], "foo" ), + dump_bless( array(), "foo" ), "bless [], 'foo' (2)" ], [ - do { my $qr= bless qr/foo/ix,"bar"; [ $qr, $qr ] }, + do { my $qr= bless qr/foo/ix, "bar"; [ $qr, $qr ] }, do { my $content= array_head(2); my $pos= offset($content); - join("", $content, + join( + "", $content, chr(SRL_HDR_OBJECT), short_string("bar"), chr(SRL_HDR_REFN), - chr(SRL_HDR_REGEXP + TRACK_FLAG), + chr( SRL_HDR_REGEXP + TRACK_FLAG ), short_string("foo"), short_string("ix"), chr(SRL_HDR_REFP), - varint($pos + 6 ), - ) + varint( $pos + 6 ), + ); }, "blessed regexp with reuse" ], [ - do { my $o1=bless [], "foo"; my $o2=bless [], "foo"; [ $o1, $o2, $o1, $o2 ] }, + do { my $o1= bless [], "foo"; my $o2= bless [], "foo"; [ $o1, $o2, $o1, $o2 ] }, do { - my $content= array_head(4). chr(SRL_HDR_OBJECT); + my $content= array_head(4) . chr(SRL_HDR_OBJECT); my $pos= offset($content); - join("",$content, - short_string("foo"), - chr(SRL_HDR_REFN).chr(SRL_HDR_ARRAY + TRACK_FLAG),varint(0), - chr( SRL_HDR_OBJECT + $use_objectv), - $use_objectv ? () : chr(SRL_HDR_COPY), varint($pos), - chr(SRL_HDR_REFN).chr(SRL_HDR_ARRAY + TRACK_FLAG), varint(0), - chr(SRL_HDR_REFP),varint($pos + 5), - chr(SRL_HDR_REFP),varint($pos + 10), - ) + join( + "", $content, + short_string("foo"), + chr(SRL_HDR_REFN) . chr( SRL_HDR_ARRAY + TRACK_FLAG ), varint(0), + chr( SRL_HDR_OBJECT + $use_objectv ), + $use_objectv ? () : chr(SRL_HDR_COPY), varint($pos), + chr(SRL_HDR_REFN) . chr( SRL_HDR_ARRAY + TRACK_FLAG ), varint(0), + chr(SRL_HDR_REFP), varint( $pos + 5 ), + chr(SRL_HDR_REFP), varint( $pos + 10 ), + ); }, "blessed arrays with reuse" ], [ - [bless([], "foo"), bless([], "foo")], + [ bless( [], "foo" ), bless( [], "foo" ) ], do { - my $content = array_head(2) . chr(SRL_HDR_OBJECT); - my $pos = offset($content); - $content .= short_string("foo") - . array() - . dump_bless( array(), \$pos ) - ; - $content + my $content= array_head(2) . chr(SRL_HDR_OBJECT); + my $pos= offset($content); + $content .= short_string("foo") . array() . dump_bless( array(), \$pos ); + $content; }, "reused classname empty array" ], [ - bless([bless {}, "foo"], "foo"), + bless( [ bless {}, "foo" ], "foo" ), do { - my $content = chr(SRL_HDR_OBJECT); - my $pos = offset($content); - $content .= short_string("foo") - . array_head(1) - . dump_bless(hash(), \$pos); - ; - $content + my $content= chr(SRL_HDR_OBJECT); + my $pos= offset($content); + $content .= short_string("foo") . array_head(1) . dump_bless( hash(), \$pos ); + $content; }, "wrapped objects" ], [ qr/foo/, dump_bless( - chr(SRL_HDR_REFN) - .chr(SRL_HDR_REGEXP) - .short_string("foo") - .short_string(""), + chr(SRL_HDR_REFN) . chr(SRL_HDR_REGEXP) . short_string("foo") . short_string(""), "Regexp" ), "qr/foo/" @@ -520,10 +568,10 @@ [ qr/(?i-xsm:foo)/, dump_bless( - chr(SRL_HDR_REFN) - .chr(SRL_HDR_REGEXP) - .short_string("(?i-xsm:foo)") - .short_string(""), + chr(SRL_HDR_REFN) + . chr(SRL_HDR_REGEXP) + . short_string("(?i-xsm:foo)") + . short_string(""), "Regexp" ), "qr/(?i-xsm:foo)/" @@ -531,19 +579,16 @@ [ qr/foo/i, dump_bless( - chr(SRL_HDR_REFN) - .chr(SRL_HDR_REGEXP) - .short_string("foo") - .short_string("i"), + chr(SRL_HDR_REFN) . chr(SRL_HDR_REGEXP) . short_string("foo") . short_string("i"), "Regexp" ), "qr/foo/i" ], [ - [{foo => 1}, {foo => 2}], + [ { foo => 1 }, { foo => 2 } ], sub { - my $opt = shift; - if ($opt->{no_shared_hashkeys}) { + my $opt= shift; + if ( $opt->{no_shared_hashkeys} ) { return array( hash( short_string("foo"), @@ -565,10 +610,10 @@ integer(1), ), hash( - chr(SRL_HDR_COPY) . varint(offset($content)+1), + chr(SRL_HDR_COPY) . varint( offset($content) + 1 ), integer(2), ), - ) + ); } }, "duplicate hash keys" @@ -576,11 +621,12 @@ [ { $unicode1 => $unicode2 }, hash( - chr(SRL_HDR_STR_UTF8) . varint(bytes::length($unicode1)) . encode_utf8($unicode1), - chr(SRL_HDR_STR_UTF8) . varint(bytes::length($unicode2)) . encode_utf8($unicode2), + chr(SRL_HDR_STR_UTF8) . varint( bytes::length($unicode1) ) . encode_utf8($unicode1), + chr(SRL_HDR_STR_UTF8) . varint( bytes::length($unicode2) ) . encode_utf8($unicode2), ), "simple unicode hash key and value" ], + # Test true/false. Due to some edge case behavior in perl these two tests # produce different "expected" results depending on such things as how many # times we perform the test. Therefore we allow various "alternates" to @@ -593,99 +639,100 @@ # on perl 5.14, but the second test requires one of those options. Working around # perl bugs sucks. [ - sub { \@_ }->(!1,!0), - array(chr(SRL_HDR_FALSE),chr(SRL_HDR_TRUE)), # this is the "correct" response. + sub { \@_ } + ->( !1, !0 ), + array( chr(SRL_HDR_FALSE), chr(SRL_HDR_TRUE) ), # this is the "correct" response. "true/false (prefered order)", - permute_array( - [ + permute_array( [ short_string(""), chr(SRL_HDR_FALSE), ], [ chr(SRL_HDR_TRUE), short_string("1"), - integer(1) - ] - ), # this is what threaded perls will probably match + integer(1) ] + ), # this is what threaded perls will probably match ], [ - sub { \@_ }->(!1,!0), - array(short_string(""),short_string("1")), # this is the expected value on perl 5.14 unthreaded + sub { \@_ } + ->( !1, !0 ), + array( short_string(""), short_string("1") ), # this is the expected value on perl 5.14 unthreaded "true/false (reversed alternates)", - permute_array( - [ + permute_array( [ short_string(""), chr(SRL_HDR_FALSE) ], [ chr(SRL_HDR_TRUE), integer(1), - short_string("1") - ] + short_string("1") ] ), ], ); } - - sub have_encoder_and_decoder { my ($min_v)= @_; + # $Class is the already-loaded class, so the one we're testing - my @need = $Class =~ /Encoder/ ? ("Decoder") : - $Class =~ /Decoder/ ? ("Encoder") : - ("Encoder", "Decoder"); - my @need_class = ($Class, map { "Sereal::$_" } @need); + my @need= + $Class =~ /Encoder/ ? ("Decoder") + : $Class =~ /Decoder/ ? ("Encoder") + : ( "Encoder", "Decoder" ); + my @need_class= ( $Class, map { "Sereal::$_" } @need ); foreach my $class (@need_class) { eval "use $class; 1" - or do { - note("Could not locate $class for testing" . ($@ ? " (Exception: $@)" : "")); - return(); - }; + or do { + note( "Could not locate $class for testing" . ( $@ ? " (Exception: $@)" : "" ) ); + return (); + }; my $cmp_v= $class->VERSION; - if ($min_v and $cmp_v < $min_v) { - diag("Could not load correct version of $class for testing " - ."(got: $cmp_v, needed at least $min_v)"); + if ( $min_v and $cmp_v < $min_v ) { + diag( "Could not load correct version of $class for testing " + . "(got: $cmp_v, needed at least $min_v)" ); return; } $cmp_v =~ s/_//; - $cmp_v = sprintf("%.2f", int($cmp_v*100)/100); - my %compat_versions = map {$_ => 1} $Class->_test_compat(); - if (not defined $cmp_v or not exists $compat_versions{$cmp_v}) { - diag("Could not load correct version of $class for testing " - ."(got: $cmp_v, needed any of ".join(", ", keys %compat_versions).")"); - return(); + $cmp_v= sprintf( "%.2f", int( $cmp_v * 100 ) / 100 ); + my %compat_versions= map { $_ => 1 } $Class->_test_compat(); + if ( not defined $cmp_v or not exists $compat_versions{$cmp_v} ) { + diag( "Could not load correct version of $class for testing " + . "(got: $cmp_v, needed any of " + . join( ", ", keys %compat_versions ) + . ")" ); + return (); } } return 1; } - # max iv/uv logic taken from Storable tests -my $max_uv = ~0; -my $max_uv_m1 = ~0 ^ 1; +my $max_uv= ~0; +my $max_uv_m1= ~0 ^ 1; + # Express it in this way so as not to use any addition, as 5.6 maths would # do this in NVs on 64 bit machines, and we're overflowing IVs so can't use # use integer. -my $max_iv_p1 = $max_uv ^ ($max_uv >> 1); -my $lots_of_9C = do { - my $temp = sprintf "%#x", ~0; +my $max_iv_p1= $max_uv ^ ( $max_uv >> 1 ); +my $lots_of_9C= do { + my $temp= sprintf "%#x", ~0; $temp =~ s/ff/9c/g; local $^W; no warnings; eval $temp; }; -my $max_iv = ~0 >> 1; -my $min_iv = do {use integer; -$max_iv-1}; # 2s complement assumption +my $max_iv= ~0 >> 1; +my $min_iv= do { use integer; -$max_iv - 1 }; # 2s complement assumption -my @numstr= map { ; no warnings; $_ < 0 and warn "this shouldnt happpen"; $_ } - ( " 1 ", "0.0", "00000.0000", "0.0.0.0", ".0"," .0", " 22", - "01", "01.1", " 0 ", ".0", "0.001", ".1", " .1", ".2", "00", ".00", - "0 but true", "0E0"); +my @numstr= map { ; no warnings; $_ < 0 and warn "this shouldnt happpen"; $_ } ( + " 1 ", "0.0", "00000.0000", "0.0.0.0", ".0", " .0", " 22", + "01", "01.1", " 0 ", ".0", "0.001", ".1", " .1", ".2", "00", ".00", + "0 but true", "0E0" +); my $eng0e0= "0e0"; my $eng0e1= "0e1"; my $eng2= "1e3"; @@ -693,136 +740,219 @@ my $sum= $eng0e0 + $eng0e1 + $eng2; sub encoder_required { - my ($ver, $name)= @_; - return "" . ( $Sereal::Encoder::VERSION < $ver ? "TODO " : "") . $name; + my ( $ver, $name )= @_; + return "" . ( $Sereal::Encoder::VERSION < $ver ? "TODO " : "" ) . $name; } sub _get_roundtrip_tests { - my @ScalarRoundtripTests = ( + my @ScalarRoundtripTests= ( + # name, structure - ["undef", undef], - ["small int", 3], - ["small negative int", -8], - ["largeish int", 100000], - ["largeish negative int -302001", -302001], - ["largeish negative int -1234567", -1234567], - ["largeish negative int -12345678", -12345678], + [ "undef", undef ], + [ "small int", 3 ], + [ "small negative int", -8 ], + [ "largeish int", 100000 ], + [ "largeish negative int -302001", -302001 ], + [ "largeish negative int -1234567", -1234567 ], + [ "largeish negative int -12345678", -12345678 ], ( - map {["integer: $_", 0+$_]} ( + map { [ "integer: $_", 0 + $_ ] } ( + # IV bounds of 8 bits -1, 0, 1, -127, -128, -129, 42, 126, 127, 128, 129, 254, 255, 256, 257, + # IV bounds of 32 bits -2147483647, -2147483648, -2147483649, 2147483646, 2147483647, 2147483648, + # IV bounds - $min_iv, do {use integer; $min_iv + 1}, do {use integer; $max_iv - 1}, + $min_iv, do { use integer; $min_iv + 1 }, do { use integer; $max_iv - 1 }, $max_iv, + # UV bounds at 32 bits 0x7FFFFFFF, 0x80000000, 0x80000001, 0xFFFFFFFF, 0xDEADBEEF, + # UV bounds $max_iv_p1, $max_uv_m1, $max_uv, $lots_of_9C, - $eng0e0, $eng0e1, $eng2, + $eng0e0, $eng0e1, $eng2, + ) + ), + ( map { [ "float $_", 0 + $_ ] } ( 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9 ) ), + [ "short ascii string", "fooo" ], + [ "short latin1 string", "Müller" ], + [ + "short utf8 string", + do { use utf8; " עדיין ח" } + ], + + ( + map { [ + "long ascii string 'a' x $_", + do { "a" x $_ } + ] + } ( + 9999, 10000, 10001, + 1023, 1024, 1025, + 8191, 8192, 8193, + ) + ), + ( + map { [ + "long ascii string 'ab' x $_", + do { "ab" x $_ } + ] + } ( + 9999, 10000, 10001, + 1023, 1024, 1025, + 8191, 8192, 8193, + ) + ), + ( + map { [ + "long ascii string 'abc' x $_", + do { "abc" x $_ } + ] + } ( + 9999, 10000, 10001, + 1023, 1024, 1025, + 8191, 8192, 8193, ) ), - (map { ["float $_", 0+$_] } (0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9)), - ["short ascii string", "fooo"], - ["short latin1 string", "Müller"], - ["short utf8 string", do {use utf8; " עדיין ח"} ], - - (map { [ "long ascii string 'a' x $_", do{"a" x $_} ] } ( - 9999,10000,10001, - 1023,1024,1025, - 8191,8192,8193, - )), - (map { [ "long ascii string 'ab' x $_", do{"ab" x $_} ] } ( - 9999,10000,10001, - 1023,1024,1025, - 8191,8192,8193, - )), - (map { [ "long ascii string 'abc' x $_", do{"abc" x $_} ] } ( - 9999,10000,10001, - 1023,1024,1025, - 8191,8192,8193, - )), - (map { [ "long ascii string 'abcd' x $_", do{"abcd" x $_} ] } ( - 9999,10000,10001, - 1023,1024,1025, - 8191,8192,8193, - )), - ( map { [ encoder_required(3.005002, " troublesome num/strs '$_'"), - $_ ] } @numstr ), - ["long latin1 string", "üll" x 10000], - ["long utf8 string", do {use utf8; " עדיין חשב" x 10000}], - ["long utf8 string with only ascii", do {use utf8; "foo" x 10000}], - ["long utf8 string with only latin1 subset", do {use utf8; "üll" x 10000}], - - ["simple regexp", qr/foo/], - ["regexp with inline modifiers", qr/(?i-xsm:foo)/], - ["regexp with modifiers", qr/foo/i], - ["float", 123013.139], - ["negative float",-1234.59], - ["small float 0.41",0.41], - ["negative small float -0.13",-0.13], - ["small int", 123], - ["empty string", ''], - ["simple array", []], - ["empty hash", {}], - ["simple hash", { foo => 'bar' }], - ["undef value", { foo => bar => baz => undef }], - ["simple array", [ 1 ]], - ["nested simple", [ 1, [ 2 ] ] ], - ["deep nest", [1,2,[3,4,{5=>6,7=>{8=>[]},9=>{}},{},[]]]], - ["complex hash", { - foo => 123, - bar => -159, pi => 3, - 'baz' =>"foo", - 'bop \''=> "\10" - ,'bop \'\\'=> "\x{100}" , - 'bop \'x\\x' =>"x\x{100}" , 'bing' => "x\x{100}", - x=>'y', z => 'p', i=> '1', l=>" \10", m=>"\10 ", n => " \10 ", - }], - ["complex hash with float", { - foo => 123, - bar => -159.23, a_pi => 3.14159, - 'baz' =>"foo", - 'bop \''=> "\10" - ,'bop \'\\'=> "\x{100}" , - 'bop \'x\\x' =>"x\x{100}" , 'bing' => "x\x{100}", - x=>'y', z => 'p', i=> '1', l=>" \10", m=>"\10 ", n => " \10 ", - }], - ["more complex", { - foo => [123], - "bar" => [-159, n => 3, { 'baz' => "foo", }, ], - 'bop \''=> { "\10" => { 'bop \'\\'=> "\x{100}", h=>{ - 'bop \'x\\x' =>"x\x{100}" , 'bing' => "x\x{100}", - x=>'y',}, z => 'p' , } , - i => '1' ,}, l=>" \10", m=>"\10 ", n => " \10 ", - o => undef ,p=>undef, q=>\undef, r=>\$eng0e0, u => \$eng0e1, w=>\$eng2 - }], - ["more complex with float", { - foo => [123], - "bar" => [-159.23, a_pi => 3.14159, { 'baz' => "foo", }, ], - 'bop \''=> { "\10" => { 'bop \'\\'=> "\x{100}", h=>{ - 'bop \'x\\x' =>"x\x{100}" , 'bing' => "x\x{100}", - x=>'y',}, z => 'p' , } , - i => '1' ,}, l=>" \10", m=>"\10 ", n => " \10 ", - o => undef ,p=>undef, q=>\undef, r=>\$eng0e0, u => \$eng0e1, w=>\$eng2 - }], - ['var strings', [ "\$", "\@", "\%" ]], - [ "quote keys", { "" => '"', "'" => "" }], - [ "ref to foo", \"foo" ], - [ "double ref to foo", \\"foo"], - [ "refy array", \\["foo"]], - [ "reffy hash", \\\{foo=>\"bar"}], - [ "blessed array", bless(\[],"foo")], - [ "utf8 string", "123\\277ABC\\x{DF}456"], - [ "escaped string", "\\012\345\267\145123\\277ABC\\x{DF}456"], - [ "more escapes", "\\0123\0124"], - [ "ref to undef", \undef], - [ "negative big num", -4123456789], - [ "positive big num", 4123456789], - [ "eng-ref", [\$eng0e0, \$eng0e1, \$eng2] ], - [ "undef", [\undef, \undef] ], + ( + map { [ + "long ascii string 'abcd' x $_", + do { "abcd" x $_ } + ] + } ( + 9999, 10000, 10001, + 1023, 1024, 1025, + 8191, 8192, 8193, + ) + ), + ( + map { [ + encoder_required( 3.005002, " troublesome num/strs '$_'" ), + $_ + ] + } @numstr + ), + [ "long latin1 string", "üll" x 10000 ], + [ + "long utf8 string", + do { use utf8; " עדיין חשב" x 10000 } + ], + [ + "long utf8 string with only ascii", + do { use utf8; "foo" x 10000 } + ], + [ + "long utf8 string with only latin1 subset", + do { use utf8; "üll" x 10000 } + ], + + [ "simple regexp", qr/foo/ ], + [ "regexp with inline modifiers", qr/(?i-xsm:foo)/ ], + [ "regexp with modifiers", qr/foo/i ], + [ "float", 123013.139 ], + [ "negative float", -1234.59 ], + [ "small float 0.41", 0.41 ], + [ "negative small float -0.13", -0.13 ], + [ "small int", 123 ], + [ "empty string", '' ], + [ "simple array", [] ], + [ "empty hash", {} ], + [ "simple hash", { foo => 'bar' } ], + [ "undef value", { foo => bar => baz => undef } ], + [ "simple array", [1] ], + [ "nested simple", [ 1, [2] ] ], + [ "deep nest", [ 1, 2, [ 3, 4, { 5 => 6, 7 => { 8 => [] }, 9 => {} }, {}, [] ] ] ], + [ + "complex hash", { + foo => 123, + bar => -159, pi => 3, + 'baz' => "foo", + 'bop \'' => "\10", 'bop \'\\' => "\x{100}", + 'bop \'x\\x' => "x\x{100}", 'bing' => "x\x{100}", + x => 'y', z => 'p', i => '1', l => " \10", m => "\10 ", n => " \10 ", + } + ], + [ + "complex hash with float", { + foo => 123, + bar => -159.23, a_pi => 3.14159, + 'baz' => "foo", + 'bop \'' => "\10", 'bop \'\\' => "\x{100}", + 'bop \'x\\x' => "x\x{100}", 'bing' => "x\x{100}", + x => 'y', z => 'p', i => '1', l => " \10", m => "\10 ", n => " \10 ", + } + ], + [ + "more complex", { + foo => [123], + "bar" => [ -159, n => 3, { 'baz' => "foo", }, ], + 'bop \'' => { + "\10" => { + 'bop \'\\' => "\x{100}", + h => { + 'bop \'x\\x' => "x\x{100}", 'bing' => "x\x{100}", + x => 'y', + }, + z => 'p', + }, + i => '1', + }, + l => " \10", + m => "\10 ", + n => " \10 ", + o => undef, + p => undef, + q => \undef, + r => \$eng0e0, + u => \$eng0e1, + w => \$eng2 + } + ], + [ + "more complex with float", { + foo => [123], + "bar" => [ -159.23, a_pi => 3.14159, { 'baz' => "foo", }, ], + 'bop \'' => { + "\10" => { + 'bop \'\\' => "\x{100}", + h => { + 'bop \'x\\x' => "x\x{100}", 'bing' => "x\x{100}", + x => 'y', + }, + z => 'p', + }, + i => '1', + }, + l => " \10", + m => "\10 ", + n => " \10 ", + o => undef, + p => undef, + q => \undef, + r => \$eng0e0, + u => \$eng0e1, + w => \$eng2 + } + ], + [ 'var strings', [ "\$", "\@", "\%" ] ], + [ "quote keys", { "" => '"', "'" => "" } ], + [ "ref to foo", \"foo" ], + [ "double ref to foo", \\"foo" ], + [ "refy array", \\["foo"] ], + [ "reffy hash", \\\{ foo => \"bar" } ], + [ "blessed array", bless( \[], "foo" ) ], + [ "utf8 string", "123\\277ABC\\x{DF}456" ], + [ "escaped string", "\\012\345\267\145123\\277ABC\\x{DF}456" ], + [ "more escapes", "\\0123\0124" ], + [ "ref to undef", \undef ], + [ "negative big num", -4123456789 ], + [ "positive big num", 4123456789 ], + [ "eng-ref", [ \$eng0e0, \$eng0e1, \$eng2 ] ], + [ "undef", [ \undef, \undef ] ], ); my @blessed_array_check1; @@ -830,109 +960,132 @@ $blessed_array_check1[1]= bless \$blessed_array_check1[0], "BlessedArrayCheck"; $blessed_array_check1[2]= \$blessed_array_check1[0]; - my @blessed_array_check2= (3,0,0,3); + my @blessed_array_check2= ( 3, 0, 0, 3 ); $blessed_array_check2[1]= \$blessed_array_check2[0]; $blessed_array_check2[2]= \$blessed_array_check2[3]; bless \$blessed_array_check2[0], "BlessedArrayCheck"; bless \$blessed_array_check2[3], "BlessedArrayCheck"; - my @sc_array=(1,1); - $sc_array[0]=bless \$sc_array[1], "BlessedArrayLeft"; - $sc_array[1]=bless \$sc_array[0], "BlessedArrayRight"; + my @sc_array= ( 1, 1 ); + $sc_array[0]= bless \$sc_array[1], "BlessedArrayLeft"; + $sc_array[1]= bless \$sc_array[0], "BlessedArrayRight"; - - my @RoundtripTests = ( + my @RoundtripTests= ( @ScalarRoundtripTests, - [ encoder_required(3.006006,"BlessedArrayCheck 1"), \@blessed_array_check1 ], - [ encoder_required(3.006006,"BlessedArrayCheck 2"), \@blessed_array_check2 ], - [ encoder_required(3.006006,"Scalar Cross Blessed Array"), \@sc_array ], - - ["[{foo => 1}, {foo => 2}] - repeated hash keys", - [{foo => 1}, {foo => 2}] ], - - (map {["scalar ref to " . $_->[0], (\($_->[1]))]} @ScalarRoundtripTests), - (map {["nested scalar ref to " . $_->[0], (\\($_->[1]))]} @ScalarRoundtripTests), - (map {["array ref to " . $_->[0], ([$_->[1]])]} @ScalarRoundtripTests), - (map {["hash ref to " . $_->[0], ({foo => $_->[1]})]} @ScalarRoundtripTests), + [ encoder_required( 3.006006, "BlessedArrayCheck 1" ), \@blessed_array_check1 ], + [ encoder_required( 3.006006, "BlessedArrayCheck 2" ), \@blessed_array_check2 ], + [ encoder_required( 3.006006, "Scalar Cross Blessed Array" ), \@sc_array ], + + [ + "[{foo => 1}, {foo => 2}] - repeated hash keys", + [ { foo => 1 }, { foo => 2 } ] + ], + + ( map { [ "scalar ref to " . $_->[0], ( \( $_->[1] ) ) ] } @ScalarRoundtripTests ), + ( map { [ "nested scalar ref to " . $_->[0], ( \\( $_->[1] ) ) ] } @ScalarRoundtripTests ), + ( map { [ "array ref to " . $_->[0], ( [ $_->[1] ] ) ] } @ScalarRoundtripTests ), + ( map { [ "hash ref to " . $_->[0], ( { foo => $_->[1] } ) ] } @ScalarRoundtripTests ), + # --- - (map {["array ref to duplicate " . $_->[0], ([$_->[1], $_->[1]])]} @ScalarRoundtripTests), - (map {[ - "AoA of duplicates " . $_->[0], - ( [ $_->[1], [ $_->[1], $_->[1] ], $_->[1], [ $_->[1], $_->[1], $_->[1] ], $_->[1] ] ) - ]} @ScalarRoundtripTests), + ( + map { [ "array ref to duplicate " . $_->[0], ( [ $_->[1], $_->[1] ] ) ] } + @ScalarRoundtripTests + ), + ( + map { [ + "AoA of duplicates " . $_->[0], + ( [ + $_->[1], [ $_->[1], $_->[1] ], $_->[1], [ $_->[1], $_->[1], $_->[1] ], + $_->[1] ] ) ] + } @ScalarRoundtripTests + ), + # --- - (map {["array ref to aliases " . $_->[0], (sub {\@_}->($_->[1], $_->[1]))]} @ScalarRoundtripTests), - (map {["array ref to scalar refs to same " . $_->[0], ([\($_->[1]), \($_->[1])])]} @ScalarRoundtripTests), + ( + map { [ + "array ref to aliases " . $_->[0], ( + sub { \@_ } + ->( $_->[1], $_->[1] ) ) ] + } @ScalarRoundtripTests + ), + ( + map { [ + "array ref to scalar refs to same " . $_->[0], + ( [ \( $_->[1] ), \( $_->[1] ) ] ) ] + } @ScalarRoundtripTests + ), ); - if (eval "use Array::RefElem (av_store hv_store); 1") { + if ( eval "use Array::RefElem (av_store hv_store); 1" ) { my $x= "alias!"; - my (@av,%hv); - av_store(@av,0,$x); - av_store(@av,1,$x); - hv_store(%hv,"x", $x); - hv_store(%hv,"y", $x); + my ( @av, %hv ); + av_store( @av, 0, $x ); + av_store( @av, 1, $x ); + hv_store( %hv, "x", $x ); + hv_store( %hv, "y", $x ); push @RoundtripTests, - [\@av,"alias in array"], - [\%hv,"alias in hash"], - [[\@av,\%hv,\$x], "alias hell"]; + [ \@av, "alias in array" ], + [ \%hv, "alias in hash" ], + [ [ \@av, \%hv, \$x ], "alias hell" ]; } return @RoundtripTests; } - - sub run_roundtrip_tests { - my ($name, $opts) = @_; + my ( $name, $opts )= @_; my $proto_version; - if ( $0 =~ m![\\/]v(\d+)[\\/]!) { + if ( $0 =~ m![\\/]v(\d+)[\\/]! ) { $proto_version= $1; - } else { + } + else { die "Failed to detect version\n"; } - my $suffix = "_v$proto_version"; - if ($proto_version == 1) { - $opts->{use_protocol_v1} = 1; + my $suffix= "_v$proto_version"; + if ( $proto_version == 1 ) { + $opts->{use_protocol_v1}= 1; } else { # v2 ignores this, but will output v2 by default - $opts->{protocol_version} = $proto_version; + $opts->{protocol_version}= $proto_version; } setup_tests($proto_version); - run_roundtrip_tests_internal($name . $suffix, $opts); + run_roundtrip_tests_internal( $name . $suffix, $opts ); } sub _test { - my ($msg, $v1, $v2)= @_; + my ( $msg, $v1, $v2 )= @_; + # require Data::Dumper not needed, called in parent frame - if ($v1 ne $v2) { + if ( $v1 ne $v2 ) { my $q1= Data::Dumper::qquote($v1); my $q2= Data::Dumper::qquote($v2); - return "$msg: $q1 ne $q2" + return "$msg: $q1 ne $q2"; } return; } sub _cmp_str { - my ($v1, $v2)= @_; + my ( $v1, $v2 )= @_; my $v1_is_utf8= is_utf8($v1); my $v2_is_utf8= is_utf8($v2); - Encode::_utf8_off($v1); # turn off utf8, in case it is corrupt - Encode::_utf8_off($v2); # turn off utf8, in case it is corrupt - if ($v1 eq $v2) { + Encode::_utf8_off($v1); # turn off utf8, in case it is corrupt + Encode::_utf8_off($v2); # turn off utf8, in case it is corrupt + if ( $v1 eq $v2 ) { return; } my $diff_start= 0; - $diff_start++ while $diff_start < length($v1) - and $diff_start < length($v2) - and substr($v1, $diff_start,1) eq substr($v2, $diff_start,1); + $diff_start++ + while $diff_start < length($v1) + and $diff_start < length($v2) + and substr( $v1, $diff_start, 1 ) eq substr( $v2, $diff_start, 1 ); my $diff_end= length($v1) < length($v2) ? length($v1) : length($v2); - $diff_end-- while $diff_end > $diff_start - and $diff_end > $diff_start - and substr($v1, $diff_end-1,1) eq substr($v2, $diff_end-1,1); + $diff_end-- + while $diff_end > $diff_start + and $diff_end > $diff_start + and substr( $v1, $diff_end - 1, 1 ) eq substr( $v2, $diff_end - 1, 1 ); my $length_to_show= $diff_end - $diff_start; my $max_context_len= 10; @@ -941,43 +1094,56 @@ $length_to_show= $max_diff_len if $length_to_show > $max_diff_len; # require Data::Dumper not needed, called in parent frame - my $q1= Data::Dumper::qquote(substr($v1, $diff_start, $length_to_show )); - my $q2= Data::Dumper::qquote(substr($v2, $diff_start, $length_to_show )); + my $q1= Data::Dumper::qquote( substr( $v1, $diff_start, $length_to_show ) ); + my $q2= Data::Dumper::qquote( substr( $v2, $diff_start, $length_to_show ) ); my $context_start= $diff_start > $max_context_len ? $diff_start - $max_context_len : 0; - if ($context_start < $diff_start) { - $q1 = Data::Dumper::qquote(substr($v1,$context_start, $diff_start - $context_start)) . " . " . $q1; - $q2 = Data::Dumper::qquote(substr($v2,$context_start, $diff_start - $context_start)) . " . " . $q2; - } - - if ($context_start > 0) { - $q1 = "...$q1"; - $q2 = "...$q2"; - } - if ($length_to_show < $max_diff_len) { - $q1 .= " . " . Data::Dumper::qquote(substr($v1, $diff_start + $length_to_show, $max_diff_len - $length_to_show)) + if ( $context_start < $diff_start ) { + $q1= + Data::Dumper::qquote( substr( $v1, $context_start, $diff_start - $context_start ) ) + . " . " + . $q1; + $q2= + Data::Dumper::qquote( substr( $v2, $context_start, $diff_start - $context_start ) ) + . " . " + . $q2; + } + + if ( $context_start > 0 ) { + $q1= "...$q1"; + $q2= "...$q2"; + } + if ( $length_to_show < $max_diff_len ) { + $q1 .= " . " + . Data::Dumper::qquote( + substr( $v1, $diff_start + $length_to_show, $max_diff_len - $length_to_show ) ) if $diff_start + $length_to_show < length($v1); - $q2 .= " . " . Data::Dumper::qquote(substr($v2, $diff_start + $length_to_show, $max_diff_len - $length_to_show)) + $q2 .= " . " + . Data::Dumper::qquote( + substr( $v2, $diff_start + $length_to_show, $max_diff_len - $length_to_show ) ) if $diff_start + $length_to_show < length($v2); } if ( $diff_start + $max_diff_len <= length($v1) ) { - $q1 .= "..." + $q1 .= "..."; } if ( $diff_start + $max_diff_len <= length($v2) ) { - $q2 .= "..." + $q2 .= "..."; } my $pad= length($q1) > length($q2) ? length($q1) : length($q2); - my $lpad= length(length($v1)) > length(length($v2)) ? length(length($v1)) : length(length($v2)); + my $lpad= + length( length($v1) ) > length( length($v2) ) + ? length( length($v1) ) + : length( length($v2) ); my $issues= ""; - $issues .="; utf8 mismatch" if $v1_is_utf8 != $v2_is_utf8; - $issues .="; length mismatch" if length($v1) != length($v2); + $issues .= "; utf8 mismatch" if $v1_is_utf8 != $v2_is_utf8; + $issues .= "; length mismatch" if length($v1) != length($v2); - my $ret= sprintf( "strings different\n" - . "first string difference at octet offset %d%s\n" - . " got-octets = %*s (octets: %*d, utf8-flag: %d)\n" - . "want-octets = %*s (octets: %*d, utf8-flag: %d)\n" - ,$diff_start, $issues, + my $ret= sprintf( + "strings different\n" + . "first string difference at octet offset %d%s\n" + . " got-octets = %*s (octets: %*d, utf8-flag: %d)\n" + . "want-octets = %*s (octets: %*d, utf8-flag: %d)\n", $diff_start, $issues, -$pad, $q1, $lpad, length($v1), $v1_is_utf8, -$pad, $q2, $lpad, length($v2), $v2_is_utf8, ); @@ -985,64 +1151,72 @@ } sub _deep_cmp { - my ($x, $y, $seenx, $seeny)= @_; + my ( $x, $y, $seenx, $seeny )= @_; $seenx ||= {}; $seeny ||= {}; my $cmp; - $cmp= _test("defined mismatch",defined($x),defined($y)) + $cmp= _test( "defined mismatch", defined($x), defined($y) ) and return $cmp; defined($x) or return ""; - $cmp= _test("seen scalar ", ++$seenx->{refaddr \$_[0]}, ++$seeny->{refaddr \$_[1]}) - || _test("boolean mismatch",!!$x, !!$y) - || _test("isref mismatch",!!ref($x), !!ref($y)) + $cmp= + _test( "seen scalar ", ++$seenx->{ refaddr \$_[0] }, ++$seeny->{ refaddr \$_[1] } ) + || _test( "boolean mismatch", !!$x, !!$y ) + || _test( "isref mismatch", !!ref($x), !!ref($y) ) and return $cmp; - if (ref $x) { - $cmp= _test("seen ref", ++$seenx->{refaddr $x}, ++$seeny->{refaddr $y}) - || _test("reftype mismatch",reftype($x), reftype($y)) - || _test("class mismatch", !blessed($x), !blessed($y)) - || _test("class different", blessed($x) || "", blessed($y) || "") + if ( ref $x ) { + $cmp= + _test( "seen ref", ++$seenx->{ refaddr $x}, ++$seeny->{ refaddr $y} ) + || _test( "reftype mismatch", reftype($x), reftype($y) ) + || _test( "class mismatch", !blessed($x), !blessed($y) ) + || _test( "class different", blessed($x) || "", blessed($y) || "" ) and return $cmp; - return "" if $x == $y - or $seenx->{refaddr $x} > 1; + return "" + if $x == $y + or $seenx->{ refaddr $x} > 1; - if (reftype($x) eq "HASH") { - $cmp= _test("keycount mismatch",0+keys(%$x),0+keys(%$y)) + if ( reftype($x) eq "HASH" ) { + $cmp= _test( "keycount mismatch", 0 + keys(%$x), 0 + keys(%$y) ) and return $cmp; - foreach my $key (keys %$x) { + foreach my $key ( keys %$x ) { return "key missing '$key'" unless exists $y->{$key}; - $cmp= _deep_cmp($x->{$key},$y->{$key}, $seenx, $seeny) + $cmp= _deep_cmp( $x->{$key}, $y->{$key}, $seenx, $seeny ) and return $cmp; } - } elsif (reftype($x) eq "ARRAY") { - $cmp= _test("arraysize mismatch",0+@$x,0+@$y) + } + elsif ( reftype($x) eq "ARRAY" ) { + $cmp= _test( "arraysize mismatch", 0 + @$x, 0 + @$y ) and return $cmp; - foreach my $idx (0..$#$x) { - $cmp= _deep_cmp($x->[$idx], $y->[$idx], $seenx, $seeny) + foreach my $idx ( 0 .. $#$x ) { + $cmp= _deep_cmp( $x->[$idx], $y->[$idx], $seenx, $seeny ) and return $cmp; } - } elsif (reftype($x) eq "SCALAR" or reftype($x) eq "REF") { - return _deep_cmp($$x, $$y, $seenx, $seeny); - } elsif (reftype($x) eq "REGEXP") { - $cmp= _test("regexp different","$x","$y") + } + elsif ( reftype($x) eq "SCALAR" or reftype($x) eq "REF" ) { + return _deep_cmp( $$x, $$y, $seenx, $seeny ); + } + elsif ( reftype($x) eq "REGEXP" ) { + $cmp= _test( "regexp different", "$x", "$y" ) and return $cmp; - } else { - die "Unknown reftype '",reftype($x)."'"; } - } else { - $cmp= _cmp_str($x,$y) + else { + die "Unknown reftype '", reftype($x) . "'"; + } + } + else { + $cmp= _cmp_str( $x, $y ) and return $cmp; } - return "" + return ""; } sub deep_cmp { - my ($v1, $v2, $name)= @_; - my $diff= _deep_cmp($v1, $v2); + my ( $v1, $v2, $name )= @_; + my $diff= _deep_cmp( $v1, $v2 ); if ($diff) { - my ($reason,$diag)= split /\n/, $diff, 2; + my ( $reason, $diag )= split /\n/, $diff, 2; fail("$name - $reason"); diag("$name - $diag") if $diag; return; @@ -1050,188 +1224,192 @@ return 1; } - sub run_roundtrip_tests_internal { - my ($ename, $opt, $encode_decode_callbacks) = @_; + my ( $ename, $opt, $encode_decode_callbacks )= @_; require Data::Dumper; - my $failed = 0; + my $failed= 0; - my $decoder = Sereal::Decoder->new($opt); - my $encoder = Sereal::Encoder->new($opt); + my $decoder= Sereal::Decoder->new($opt); + my $encoder= Sereal::Encoder->new($opt); my %seen_name; my @RoundtripTests= _get_roundtrip_tests(); foreach my $rt (@RoundtripTests) { - my ($name, $data) = @$rt; + my ( $name, $data )= @$rt; - if ($failed > 20) { + if ( $failed > 20 ) { fail("too many test failures to continue"); last; } TODO: - foreach my $meth ( - ['object-oriented', - sub {$encoder->encode($_[0])}, - sub {$decoder->decode($_[0])}], - ['functional simple', - sub {Sereal::Encoder::encode_sereal($_[0], $opt)}, - sub {Sereal::Decoder::decode_sereal($_[0], $opt)}], - ['functional with object', - sub {Sereal::Encoder::sereal_encode_with_object($encoder, $_[0])}, - sub {Sereal::Decoder::sereal_decode_with_object($decoder, $_[0])}], - ['header-body', - sub {$encoder->encode($_[0], 123456789)}, # header data is abitrary to stand out for debugging - sub {$decoder->decode($_[0])}], - ['header-only', - sub {$encoder->encode(987654321, $_[0])}, # body data is abitrary to stand out for debugging - sub {$decoder->decode_only_header($_[0])}], - ) { - my ($mname, $enc, $dec) = @$meth; + foreach my $meth ( [ + 'object-oriented', + sub { $encoder->encode( $_[0] ) }, + sub { $decoder->decode( $_[0] ) } + ], + [ + 'functional simple', + sub { Sereal::Encoder::encode_sereal( $_[0], $opt ) }, + sub { Sereal::Decoder::decode_sereal( $_[0], $opt ) } + ], + [ + 'functional with object', + sub { Sereal::Encoder::sereal_encode_with_object( $encoder, $_[0] ) }, + sub { Sereal::Decoder::sereal_decode_with_object( $decoder, $_[0] ) } + ], + [ + 'header-body', + sub { $encoder->encode( $_[0], 123456789 ) }, # header data is abitrary to stand out for debugging + sub { $decoder->decode( $_[0] ) } + ], + [ + 'header-only', + sub { $encoder->encode( 987654321, $_[0] ) }, # body data is abitrary to stand out for debugging + sub { $decoder->decode_only_header( $_[0] ) } + ], + ) + { + my ( $mname, $enc, $dec )= @$meth; - local $TODO= $name=~/TODO/ ? $name : undef; + local $TODO= $name =~ /TODO/ ? $name : undef; next if $mname =~ /header/ and $opt->{use_protocol_v1}; my $encoded; - eval {$encoded = $enc->($data); 1} - or do { - my $err = $@ || 'Zombie error'; - fail("$name ($ename, $mname, encoding failed)"); - $failed++; - }; + eval { $encoded= $enc->($data); 1 } or do { + my $err= $@ || 'Zombie error'; + fail("$name ($ename, $mname, encoding failed)"); + $failed++; + }; defined($encoded) or do { - fail("$name ($ename, $mname, encoded defined)"); - debug_checks(\$data, \$encoded, undef); - $failed++; - next; #test + fail("$name ($ename, $mname, encoded defined)"); + debug_checks( \$data, \$encoded, undef ); + $failed++; + next; #test }; my $decoded; - eval {$decoded = $dec->($encoded); 1} - or do { - my $err = $@ || 'Zombie error'; - fail("$name ($ename, $mname, decoding failed)"); - $failed++; - next; - }; + eval { $decoded= $dec->($encoded); 1 } or do { + my $err= $@ || 'Zombie error'; + fail("$name ($ename, $mname, decoding failed)"); + $failed++; + next; + }; defined($decoded) == defined($data) or do { - fail("$name ($ename, $mname, decoded definedness)"); - debug_checks(\$data, \$encoded, undef); - $failed++; - next; #test + fail("$name ($ename, $mname, decoded definedness)"); + debug_checks( \$data, \$encoded, undef ); + $failed++; + next; #test }; # Second roundtrip my $encoded2; - eval {$encoded2 = $enc->($decoded); 1} - or do { - my $err = $@ || 'Zombie error'; - fail("$name ($ename, $mname, second encoding failed)"); - $failed++; - next; #test - }; + eval { $encoded2= $enc->($decoded); 1 } or do { + my $err= $@ || 'Zombie error'; + fail("$name ($ename, $mname, second encoding failed)"); + $failed++; + next; #test + }; defined $encoded2 or do { - fail("$name ($ename, $mname, encoded2 defined)"); - $failed++; - next; #test + fail("$name ($ename, $mname, encoded2 defined)"); + $failed++; + next; #test }; my $decoded2; - eval {$decoded2 = $dec->($encoded2); 1} - or do { - my $err = $@ || 'Zombie error'; - fail("$name ($ename, $mname, second decoding failed)"); - $failed++; - next; #test - }; + eval { $decoded2= $dec->($encoded2); 1 } or do { + my $err= $@ || 'Zombie error'; + fail("$name ($ename, $mname, second decoding failed)"); + $failed++; + next; #test + }; defined($decoded2) == defined($data) or do { - fail("$name ($ename, $mname, decoded2 defined)"); - $failed++; - next; #test + fail("$name ($ename, $mname, decoded2 defined)"); + $failed++; + next; #test }; # Third roundtrip my $encoded3; - eval {$encoded3 = $enc->($decoded2); 1} - or do { - my $err = $@ || 'Zombie error'; - fail("$name ($ename, $mname, third encoding failed)"); - $failed++; - next; #test - }; + eval { $encoded3= $enc->($decoded2); 1 } or do { + my $err= $@ || 'Zombie error'; + fail("$name ($ename, $mname, third encoding failed)"); + $failed++; + next; #test + }; defined $encoded3 or do { - fail("$name ($ename, $mname, encoded3 defined)"); - $failed++; - next; #test + fail("$name ($ename, $mname, encoded3 defined)"); + $failed++; + next; #test }; my $decoded3; - eval {$decoded3 = $dec->($encoded3); 1} - or do { - my $err = $@ || 'Zombie error'; - fail("$name ($ename, $mname, third decoding failed)"); - $failed++; - next; #test - }; + eval { $decoded3= $dec->($encoded3); 1 } or do { + my $err= $@ || 'Zombie error'; + fail("$name ($ename, $mname, third decoding failed)"); + $failed++; + next; #test + }; defined($decoded3) == defined($data) or do { - fail("$name ($ename, $mname, decoded3 defined)"); - $failed++; - next; #test + fail("$name ($ename, $mname, decoded3 defined)"); + $failed++; + next; #test }; - deep_cmp($decoded, $data, "$name ($ename, $mname, decoded vs data)") - or do { $failed++; next }; #test - deep_cmp($decoded2, $data, "$name ($ename, $mname, decoded2 vs data)") - or do { $failed++; next }; #test - deep_cmp($decoded2, $decoded, "$name ($ename, $mname, decoded2 vs decoded)") - or do { $failed++; next }; #test - deep_cmp($decoded3, $data, "$name ($ename, $mname, decoded3 vs data)") - or do { $failed++; next }; #test - deep_cmp($decoded3, $decoded, "$name ($ename, $mname, decoded3 vs decoded)") - or do { $failed++; next }; #test - deep_cmp($decoded3, $decoded2, "$name ($ename, $mname, decoded3 vs decoded2)") - or do { $failed++; next }; #test + deep_cmp( $decoded, $data, "$name ($ename, $mname, decoded vs data)" ) + or do { $failed++; next }; #test + deep_cmp( $decoded2, $data, "$name ($ename, $mname, decoded2 vs data)" ) + or do { $failed++; next }; #test + deep_cmp( $decoded2, $decoded, "$name ($ename, $mname, decoded2 vs decoded)" ) + or do { $failed++; next }; #test + deep_cmp( $decoded3, $data, "$name ($ename, $mname, decoded3 vs data)" ) + or do { $failed++; next }; #test + deep_cmp( $decoded3, $decoded, "$name ($ename, $mname, decoded3 vs decoded)" ) + or do { $failed++; next }; #test + deep_cmp( $decoded3, $decoded2, "$name ($ename, $mname, decoded3 vs decoded2)" ) + or do { $failed++; next }; #test if ( $ename =~ /canon/ ) { - deep_cmp($encoded2, $encoded, "$name ($ename, $mname, encoded2 vs encoded)") - or do { $failed++; next }; #test - deep_cmp($encoded3, $encoded2, "$name ($ename, $mname, encoded3 vs encoded2)") - or do { $failed++; next }; #test - deep_cmp($encoded3, $encoded, "$name ($ename, $mname, encoded3 vs encoded)") - or do { $failed++; next }; #test + deep_cmp( $encoded2, $encoded, "$name ($ename, $mname, encoded2 vs encoded)" ) + or do { $failed++; next }; #test + deep_cmp( $encoded3, $encoded2, "$name ($ename, $mname, encoded3 vs encoded2)" ) + or do { $failed++; next }; #test + deep_cmp( $encoded3, $encoded, "$name ($ename, $mname, encoded3 vs encoded)" ) + or do { $failed++; next }; #test - if ($ENV{SEREAL_TEST_SAVE_OUTPUT} and $mname eq 'object-oriented') { + if ( $ENV{SEREAL_TEST_SAVE_OUTPUT} and $mname eq 'object-oriented' ) { use File::Path; my $combined_name= "$ename - $name"; - if (!$seen_name{$combined_name}) { - my @clean= ($ename, $name); + if ( !$seen_name{$combined_name} ) { + my @clean= ( $ename, $name ); s/[^\w.-]+/_/g, s/__+/_/g for @clean; my $cleaned= join "/", @clean; - my ($v,$p,$d)= File::Spec->splitpath($0); + my ( $v, $p, $d )= File::Spec->splitpath($0); my $dir= File::Spec->catpath( - $v, + $v, File::Spec->catdir( File::Spec->splitdir($p), - "data",$clean[0] - ) - ); + "data", $clean[0] ) ); mkpath $dir unless -d $dir; my $base= "$dir/$clean[1].enc"; $seen_name{$combined_name}= $base; - for my $f ( [ "", $encoded ], $encoded ne $encoded2 ? [ "2", $encoded2 ] : ()) { + for my $f ( + [ "", $encoded ], + $encoded ne $encoded2 ? [ "2", $encoded2 ] : () ) + { my $file= $base . $f->[0]; next if -e $file; open my $fh, ">", $file @@ -1245,14 +1423,13 @@ } } pass("$name ($ename, $mname)"); - } # end method type - } # end test type + } # end method type + } # end test type } - # dumb data-to-file dumper sub _write_file { - my ($file, $data) = @_; + my ( $file, $data )= @_; open my $fh, ">", $file or die "Failed to open file '$file' for writing: $!"; binmode($fh); @@ -1262,35 +1439,37 @@ # For bootstrapping other language implementations' tests our $COMPRESS; + sub write_test_files { - my ($dir, $version) = @_; + my ( $dir, $version )= @_; require File::Path; File::Path::mkpath($dir); - my $make_data_file_name = sub {File::Spec->catfile($dir, sprintf("test_data_%05u", shift))}; - my $make_name_file_name = sub {File::Spec->catfile($dir, sprintf("test_name_%05u", shift))}; + my $make_data_file_name= + sub { File::Spec->catfile( $dir, sprintf( "test_data_%05u", shift ) ) }; + my $make_name_file_name= + sub { File::Spec->catfile( $dir, sprintf( "test_name_%05u", shift ) ) }; setup_tests($version); - foreach my $testno (1..@BasicTests) { - my $t = $BasicTests[$testno-1]; - my $data = ref($t->[1]) eq 'CODE' ? $t->[1]->() : $t->[1]; + foreach my $testno ( 1 .. @BasicTests ) { + my $t= $BasicTests[ $testno - 1 ]; + my $data= ref( $t->[1] ) eq 'CODE' ? $t->[1]->() : $t->[1]; - _write_file($make_data_file_name->($testno), Header($PROTO_VERSION).$data); - _write_file($make_name_file_name->($testno), $t->[2] . "\n"); + _write_file( $make_data_file_name->($testno), Header($PROTO_VERSION) . $data ); + _write_file( $make_name_file_name->($testno), $t->[2] . "\n" ); } - my $encoder = Sereal::Encoder->new({ + my $encoder= Sereal::Encoder->new( { protocol_version => $PROTO_VERSION, - compress => $COMPRESS || Sereal::Encoder::SRL_UNCOMPRESSED(), - }); + compress => $COMPRESS || Sereal::Encoder::SRL_UNCOMPRESSED(), + } ); my @RoundtripTests= _get_roundtrip_tests(); - foreach my $i (0..$#RoundtripTests) { - my $testno = @BasicTests + $i + 1; - my $t = $RoundtripTests[$i]; + foreach my $i ( 0 .. $#RoundtripTests ) { + my $testno= @BasicTests + $i + 1; + my $t= $RoundtripTests[$i]; - _write_file($make_data_file_name->($testno), $encoder->encode($t->[1])); - _write_file($make_name_file_name->($testno), $t->[0] . "\n"); + _write_file( $make_data_file_name->($testno), $encoder->encode( $t->[1] ) ); + _write_file( $make_name_file_name->($testno), $t->[0] . "\n" ); } } - 1;