File: 040_tied_hash.t

package info (click to toggle)
libsereal-encoder-perl 4.018%2Bds-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 2,284 kB
  • sloc: ansic: 11,838; perl: 6,004; sh: 25; makefile: 9
file content (72 lines) | stat: -rw-r--r-- 1,588 bytes parent folder | download | duplicates (6)
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
use warnings;
use strict;

package NewStdHash;
require Tie::Hash;
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';
}
use Sereal::TestSet qw(:all);
my $u_df= "\xDFu";
utf8::upgrade($u_df);
my @keys= (
    'foo', 'bar', 'mip', 'xap', 'food', 'fool', 'fools', 'barking', 'bark',
    $u_df,
    "\x{df}a",
    "\x{c3}",
    "\x{de}",
    "\x{e0}",
    "\x{100}",
    "\x{123}",
    "\x{c4}\x{80}",
);
my $have_decoder= have_encoder_and_decoder();
if ($have_decoder) {
    plan tests => 1 + ( 4 * @keys );
}
else {
    plan tests => 1;
}

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;
}

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 {
    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" );
    }
}