File: 070_alias_options.t

package info (click to toggle)
libsereal-decoder-perl 5.004%2Bds-1
  • links: PTS, VCS
  • area: main
  • in suites: trixie
  • size: 2,556 kB
  • sloc: ansic: 11,615; perl: 6,938; sh: 25; makefile: 9
file content (61 lines) | stat: -rw-r--r-- 1,632 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
use strict;
use warnings;

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 @tests= (
    [ 15,  alias_smallint     => 1 ],
    [ 127, alias_varint_under => 128 ],
);

if ( have_encoder_and_decoder() ) {
    my $num_tests= 0;
    $num_tests += ( ( 16 + $_->[0] + 2 ) * 2 ) for @tests;
    plan tests => $num_tests;
}
else {
    plan skip_all => 'Did not find right version of encoder';
}
foreach my $test (@tests) {
    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 $struct= {
        array  => [ -16 .. $up_to ],
        array2 => [ reverse -16 .. $up_to ],
        map { $_ => $_ } -16 .. $up_to,
    };
    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: $_" );
    }

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