← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libsereal-encoder-perl/trusty-proposed

« back to all changes in this revision

Viewing changes to t/300_fail.t

  • Committer: Package Import Robot
  • Author(s): Alexandre Mestiashvili
  • Date: 2013-02-20 08:29:14 UTC
  • Revision ID: package-import@ubuntu.com-20130220082914-dljb6eixvtj2m1v2
Tags: upstream-0.31
Import upstream version 0.31

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/300_fail.t
 
1
#!perl
 
2
use strict;
 
3
use warnings;
 
4
use Sereal::Encoder;
 
5
use Sereal::Encoder::Constants qw(:all);
 
6
use File::Spec;
 
7
use Test::Warn;
 
8
 
 
9
use lib File::Spec->catdir(qw(t lib));
 
10
BEGIN {
 
11
  lib->import('lib')
 
12
    if !-d 't';
 
13
}
 
14
 
 
15
use Sereal::TestSet qw(:all);
 
16
 
 
17
use Test::More tests => 19;
 
18
 
 
19
my ($ok, $err, $out);
 
20
 
 
21
# croak_on_bless test
 
22
SCOPE: {
 
23
    my $e = Sereal::Encoder->new({
 
24
        croak_on_bless => 1,
 
25
    });
 
26
 
 
27
    is($e->encode(1), $Header.integer(1), "Encoder works before exception");
 
28
    $ok = eval{$out = $e->encode(bless({}, "Foo")); 1};
 
29
    $err = $@ || 'Zombie error';
 
30
 
 
31
    ok(!$ok, "Object throws exception");
 
32
    ok($err =~ /object/i, 'Exception refers to object');
 
33
 
 
34
    is($e->encode(1), $Header.integer(1), "Encoder works after exception");
 
35
 
 
36
    $ok =  eval {$out = $e->encode({}); 1};
 
37
    ok($ok, "Non-blessed hash does not throw exception");
 
38
 
 
39
    # test that code refs throw exception
 
40
    $ok = eval {$out = $e->encode(sub {}); 1};
 
41
    ok(!$ok, "Code ref throws exception");
 
42
}
 
43
 
 
44
# test that code refs with undef_unknown don't throw exceptions
 
45
SCOPE: {
 
46
    my $e = Sereal::Encoder->new({undef_unknown => 1});
 
47
    $ok = eval {$out = $e->encode(sub{}); 1};
 
48
    $err = $@ || 'Zombie error';
 
49
    ok($ok, "undef_unknown makes CODE encoding not fail");
 
50
    is($out, $Header . chr(SRL_HDR_UNDEF), "output is undef")
 
51
    or do {
 
52
        hobodecode($out) if $ENV{DEBUG_SEREAL};
 
53
    }
 
54
}
 
55
 
 
56
# test that code refs with stringify_unknown don't throw exceptions
 
57
SCOPE: {
 
58
    my $e = Sereal::Encoder->new({stringify_unknown => 1});
 
59
    my $sub = sub{};
 
60
    $ok = eval {$out = $e->encode($sub); 1};
 
61
    $err = $@ || 'Zombie error';
 
62
    ok($ok, "stringify_unknown makes CODE encoding not fail");
 
63
 
 
64
    my $str = $e->encode("$sub");
 
65
    is($out, $str, "output is stringified ref")
 
66
    or do {
 
67
        hobodecode($out), hobodecode($str) if $ENV{DEBUG_SEREAL};
 
68
    }
 
69
}
 
70
 
 
71
# test that code refs with warn_unknown do warn
 
72
SCOPE: {
 
73
    my $e = Sereal::Encoder->new({stringify_unknown => 1, warn_unknown => 1});
 
74
    my $sub = sub{};
 
75
    warning_like
 
76
        {
 
77
            $ok = eval {$out = $e->encode($sub); 1};
 
78
        }
 
79
        qr/Sereal/,
 
80
        "warn_unknown warns about stringified sub";
 
81
}
 
82
 
 
83
# test that blessed code refs with stringify_unknown don't throw exceptions
 
84
SCOPE: {
 
85
    my $e = Sereal::Encoder->new({stringify_unknown => 1});
 
86
    my $sub = bless(sub {}, "Foo");
 
87
    $ok = eval {$out = $e->encode($sub); 1};
 
88
    $err = $@ || 'Zombie error';
 
89
    ok($ok, "stringify_unknown makes CODE encoding not fail");
 
90
 
 
91
    my $str = $e->encode("$sub");
 
92
    is($out, $str, "output is stringified ref")
 
93
    or do {
 
94
        hobodecode($out), hobodecode($str) if $ENV{DEBUG_SEREAL};
 
95
    }
 
96
}
 
97
 
 
98
# dito for string overloading
 
99
SCOPE: {
 
100
    SCOPE2: {
 
101
        package BlessedCodeRefOverload;
 
102
        use overload '""' => sub {$_[0]->()};
 
103
        sub new {
 
104
            my ($class, $data) = @_;
 
105
            bless sub {return $data} => __PACKAGE__;
 
106
        }
 
107
    }
 
108
    SCOPE3: {
 
109
        package BlessedCodeRef;
 
110
        sub new {
 
111
            my ($class, $data) = @_;
 
112
            bless sub {return $data} => __PACKAGE__;
 
113
        }
 
114
    }
 
115
    my $e = Sereal::Encoder->new({stringify_unknown => 1});
 
116
    my $sub = BlessedCodeRefOverload->new("hello");
 
117
    is("$sub", "hello", "BlessedCodeRefOverload stringification actually works as designed");
 
118
 
 
119
    $ok = eval {$out = $e->encode($sub); 1};
 
120
    $err = $@ || 'Zombie error';
 
121
    ok($ok, "stringify_unknown makes CODE encoding not fail");
 
122
 
 
123
    my $str = $e->encode("$sub");
 
124
    is($out, $str, "output is stringified ref")
 
125
    or do {
 
126
        hobodecode($out), hobodecode($str) if $ENV{DEBUG_SEREAL};
 
127
    };
 
128
 
 
129
    # test that we get a warning with warn_unknown
 
130
    $e = Sereal::Encoder->new({stringify_unknown => 1, warn_unknown => 1});
 
131
    warning_like
 
132
        {
 
133
            $ok = eval {$out = $e->encode($sub); 1};
 
134
        }
 
135
        qr/Sereal/,
 
136
        "warn_unknown warns about stringified sub despite overloading";
 
137
 
 
138
    # Test that we do NOT get a warning with warn_unknown set to -1
 
139
    # FIXME Test::Warn doesn't have a "no_warnings" function, so let's just
 
140
    #       run this for now and hope the user will be spooked by the warning
 
141
    #       if there is one. Duh.
 
142
    $e = Sereal::Encoder->new({stringify_unknown => 1, warn_unknown => -1});
 
143
    $out = $e->encode($sub);
 
144
    ok(defined $out && $out !~ /CODE/ && $out !~ "Blessed", "RV of encode makes some sense");
 
145
 
 
146
    # Test that we DO get a warning for non-overloaded unsupported stuff
 
147
    my $sub2 = BlessedCodeRef->new("hello");
 
148
    warning_like
 
149
        {
 
150
            $ok = eval {$out = $e->encode($sub2); 1};
 
151
        }
 
152
        qr/Sereal/,
 
153
        "warn_unknown == -1 warns about stringified sub without overloading";
 
154
}
 
155
 
 
156