1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
#!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';
}
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)
# These tests are extraordinarily basic, badly-done and really just
# for basic sanity testing during development.
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 } );
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 $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";
}
};
}
}
|
