* Warning: For a seamless upgrade, upgrade to version 3
* of the decoder before upgrading to version 3 of the
* encoder!
+3.001_011 Tues, Aug 12 2014
+ - Remove use of defined-or in t/lib/TestSet.pm
+
+3.001_010 Tues, Aug 12 2014
+ - Cleanup and enhance the "alternates" testing in t/010_desperate.t
+
+3.001_007 .. 3.001_009
+ - Try to fix t/010_desperate.t on threaded perls (yes that many releases. sigh)
+
3.001_006 Sun, Aug 03 2014
- Rework bulk tests so we test more, but report less tests.
The test infrastructure doesn't play well with lots of tests
"url" : "git://github.com/Sereal/Sereal.git"
}
},
- "version" : "3.001_009"
+ "version" : "3.001_011"
}
resources:
bugtracker: https://github.com/Sereal/Sereal/issues
repository: git://github.com/Sereal/Sereal.git
-version: 3.001_009
+version: 3.001_011
use Carp qw/croak/;
use XSLoader;
-our $VERSION = '3.001_009'; # Don't forget to update the TestCompat set for testing against installed decoders!
+our $VERSION = '3.001_011'; # Don't forget to update the TestCompat set for testing against installed decoders!
our $XS_VERSION = $VERSION; $VERSION= eval $VERSION;
# not for public consumption, just for testing.
my ($extra_name, $opt_hash) = @_;
setup_tests(3);
foreach my $bt (@BasicTests) {
- my (undef, $expect, $name, $accept_cond, @accept) = @$bt;
+ my (undef, $expect, $name, @alternate) = @$bt;
- $expect = $expect->($opt_hash) if ref($expect) eq 'CODE';
$name="unnamed" if not defined $name;
#next unless $name=~/PAD/;
- $expect = Header(). $expect;
+ 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");
+ ok(defined $out, "($extra_name) defined: $name")
+ or next;
- if ($accept_cond and $out ne $expect) {
- foreach my $accept (@accept) {
+ my $alt= "";
+ if ($out ne $expect) {
+ foreach my $accept (@alternate) {
if ($out eq $accept) {
- diag("Using alternate expect for test '$name'");
$expect= $accept;
+ $alt= " - alternate";
last;
}
}
}
- is(Data::Dumper::qquote($out), Data::Dumper::qquote($expect), "($extra_name) correct: $name")
+ is(Data::Dumper::qquote($out), Data::Dumper::qquote($expect), "($extra_name) correct: $name" . $alt)
or do {
if ($ENV{DEBUG_SEREAL}) {
print STDERR "\nEXPECTED:\n";
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests("plain_canon",{canonical => 1});
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests('snappy_canon', { snappy => 1, canonical => 1 } );
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests("plain_canon",{canonical => 1});
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests('snappy_canon', { snappy => 1, canonical => 1 } );
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests(
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests("plain_canon",{canonical => 1});
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests('snappy_canon', { snappy => 1, canonical => 1 } );
my $ok = have_encoder_and_decoder();
$ok= 0 if $Sereal::Encoder::VERSION < 3.001006;
if (not $ok) {
- plan skip_all => 'Did not find right version of encoder';
+ plan skip_all => 'Did not find right version of encoder (want 3.001006)';
}
else {
run_roundtrip_tests(
use Devel::Peek;
use Encode qw(encode_utf8 is_utf8);
use Scalar::Util qw(reftype blessed refaddr);
-use Data::Dumper;
use Config;
# Dynamically load constants from whatever is being tested
sub debug_checks {
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))
if defined $data_ref;
note("Encoded data is: " . (defined($$encoded_ref) ? Data::Dumper::qquote($$encoded_ref) : "<undef>"))
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 = (
# warning: this hardcodes the POS/NEG headers
[-16, chr(0b0001_0000), "encode -16"],
),
"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
+ # be produced. An example of the underlying weirdness is that on an unthreaded
+ # linux perl 5.14 the two tests have their expected output first, which
+ # as you will note is different for the first and second call, despite the underlying
+ # code being the same both times.
+ #
+ # So for instance the first test need not have the last two options, at least
+ # 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.
+ "true/false (prefered order)",
+ array(chr(SRL_HDR_FALSE),short_string("1")), # this is what threaded perls will probably match
+ array(short_string(""),chr(SRL_HDR_TRUE)), # accept this also (but we dont expect we will)
+ array(short_string(""),short_string("1")), # accept this also (but we dont expect we will)
+ ],
[
sub { \@_ }->(!1,!0),
+ array(short_string(""),short_string("1")), # this is the expected value on perl 5.14 unthreaded
+ "true/false (reversed alternates)",
+ array(short_string(""),chr(SRL_HDR_TRUE)), # from here we just reverse the order from the first test
+ array(chr(SRL_HDR_FALSE),short_string("1")), # ....
array(chr(SRL_HDR_FALSE),chr(SRL_HDR_TRUE)),
- "true/false",
- $Config{usethreads}, # if this is true
- array(chr(SRL_HDR_FALSE),short_string("1")), # the we will accept this
- ]
+ ],
);
}
sub _test {
my ($msg, $v1, $v2)= @_;
+ # require Data::Dumper not needed, called in parent frame
if ($v1 ne $v2) {
my $q1= Data::Dumper::qquote($v1);
my $q2= Data::Dumper::qquote($v2);
$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 $context_start= $diff_start > $max_context_len ? $diff_start - $max_context_len : 0;
$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)//"")
+ || _test("class different", blessed($x) || "", blessed($y) || "")
and return $cmp;
return "" if $x == $y
or $seenx->{refaddr $x} > 1;
sub run_roundtrip_tests_internal {
my ($ename, $opt, $encode_decode_callbacks) = @_;
+ require Data::Dumper;
+
my $decoder = Sereal::Decoder->new($opt);
my $encoder = Sereal::Encoder->new($opt);
my %seen_name;
projects / libsereal-encoder-perl.git / commitdiff