« back to all changes in this revision
Viewing changes to t/400_evil.t
- browse files at revision 1.1.9
- compare with another revision
- download diff
- download tarball
- view history from revision 1.1.9
- Committer: Package Import Robot
- Author(s): gregor herrmann
- Date: 2014-06-06 13:17:09 UTC
- mto: This revision was merged to the branch mainline in revision 12.
- Revision ID: package-import@ubuntu.com-20140606131709-ek9vy22c4sh5jgjx
Tags: upstream-3.001
Import upstream version 3.001
added
removed
t/400_evil.t
2
2
use strict;
3
3
use warnings;
4
4
use Sereal::Encoder qw(:all);
5
use Sereal::Decoder qw(:all);
6
5
use Data::Dumper;
7
6
use File::Spec;
8
7
use Scalar::Util qw(blessed);
19
18
use Sereal::TestSet qw(:all);
20
19
use Test::More;
21
20
21
if (not have_encoder_and_decoder()) {
22
plan skip_all => 'Did not find right version of decoder';
23
exit 0;
24
}
25
26
Sereal::Decoder->import(":all");
27
22
28
# First, test tied hashes. Expected behaviour: We don't segfault, we don't
23
29
# throw exceptions (unless the tied hash is not iterable repeatedly),
24
30
# we serialize the tied hash as if it was a normal hash - so no trace of
25
31
# tiedness in the output.
26
27
SCOPE: {
28
package TiedHash;
29
require Tie::Hash;
30
our @ISA = qw(Tie::StdHash);
32
{
33
SCOPE: {
34
package TiedHash;
35
require Tie::Hash;
36
our @ISA = qw(Tie::StdHash);
37
}
38
39
my %testhash = (
40
foo => [qw(a b c)],
41
baz => 123,
42
dfvgbnhmjk => "345ty6ujh",
43
a => undef,
44
);
45
46
my %tied_hash;
47
tie %tied_hash => 'TiedHash';
48
%{tied(%tied_hash)} = %testhash;
49
is_deeply(\%tied_hash, \%testhash);
50
51
my ($out, $ok, $err, $data);
52
$ok = eval {$out = encode_sereal(\%tied_hash); 1};
53
$err = $@ || 'Zombie error';
54
ok($ok, "serializing tied hash did not die")
55
or note("Error was '$err'");
56
ok(defined $out, "serializing tied hash returns string");
57
58
$ok = eval {$data = decode_sereal($out); 1;};
59
$err = $@ || 'Zombie error';
60
ok($ok, "deserializing tied hash did not die")
61
or note("Error was '$err', data was:\n"), hobodecode($out);
62
ok(defined $data, "deserializing tied hash yields defined output");
63
is_deeply($data, \%testhash, "deserializing tied hash yields expected output");
31
64
}
32
65
33
my %testhash = (
34
foo => [qw(a b c)],
35
baz => 123,
36
dfvgbnhmjk => "345ty6ujh",
37
a => undef,
38
);
39
40
my %tied_hash;
41
tie %tied_hash => 'TiedHash';
42
%{tied(%tied_hash)} = %testhash;
43
is_deeply(\%tied_hash, \%testhash);
44
45
my ($out, $ok, $err, $data);
46
47
$ok = eval {$out = encode_sereal(\%tied_hash); 1};
48
$err = $@ || 'Zombie error';
49
ok($ok, "serializing tied hash did not die")
50
or note("Error was '$err'");
51
ok(defined $out, "serializing tied hash returns string");
52
53
$ok = eval {$data = decode_sereal($out); 1;};
54
$err = $@ || 'Zombie error';
55
ok($ok, "deserializing tied hash did not die")
56
or note("Error was '$err', data was:\n"), hobodecode($out);
57
ok(defined $data, "deserializing tied hash yields defined output");
58
is_deeply($data, \%testhash, "deserializing tied hash yields expected output");
59
60
61
66
62
67
# Now tied arrays.
63
64
SCOPE: {
65
package TiedArray;
66
require Tie::Array;
67
our @ISA = qw(Tie::StdArray);
68
{
69
SCOPE: {
70
package TiedArray;
71
require Tie::Array;
72
our @ISA = qw(Tie::StdArray);
73
}
74
75
my @testarray = (1, 2, "foo", "bar", []);
76
my @tied_array;
77
tie @tied_array => 'TiedArray';
78
@{tied(@tied_array)} = @testarray;
79
is_deeply(\@tied_array, \@testarray);
80
81
my ($out, $ok, $err, $data);
82
$ok = eval {$out = encode_sereal(\@tied_array); 1};
83
$err = $@ || 'Zombie error';
84
ok($ok, "serializing tied array did not die")
85
or note("Error was '$err'");
86
ok(defined $out, "serializing tied array returns string");
87
88
$ok = eval {$data = decode_sereal($out); 1;};
89
$err = $@ || 'Zombie error';
90
ok($ok, "deserializing tied array did not die")
91
or note("Error was '$err', data was:\n"), hobodecode($out);
92
ok(defined $data, "deserializing tied array yields defined output");
93
is_deeply($data, \@testarray, "deserializing tied array yields expected output");
68
94
}
69
95
70
my @testarray = (1, 2, "foo", "bar", []);
71
my @tied_array;
72
tie @tied_array => 'TiedArray';
73
@{tied(@tied_array)} = @testarray;
74
is_deeply(\@tied_array, \@testarray);
75
76
$ok = eval {$out = encode_sereal(\@tied_array); 1};
77
$err = $@ || 'Zombie error';
78
ok($ok, "serializing tied array did not die")
79
or note("Error was '$err'");
80
ok(defined $out, "serializing tied array returns string");
81
82
$ok = eval {$data = decode_sereal($out); 1;};
83
$err = $@ || 'Zombie error';
84
ok($ok, "deserializing tied array did not die")
85
or note("Error was '$err', data was:\n"), hobodecode($out);
86
ok(defined $data, "deserializing tied array yields defined output");
87
is_deeply($data, \@testarray, "deserializing tied array yields expected output");
88
89
90
96
# Now tied scalars.
91
92
SCOPE: {
93
package TiedScalar;
94
require Tie::Scalar;
95
our @ISA = qw(Tie::StdScalar);
97
{
98
99
SCOPE: {
100
package TiedScalar;
101
require Tie::Scalar;
102
our @ISA = qw(Tie::StdScalar);
103
}
104
105
my $testscalar = [qw(foo bar baz)];
106
my $tied_scalar;
107
tie $tied_scalar => 'TiedScalar';
108
${tied($tied_scalar)} = $testscalar;
109
is_deeply($tied_scalar, $testscalar);
110
111
my ($out, $ok, $err, $data);
112
$ok = eval {$out = encode_sereal(\$tied_scalar); 1};
113
$err = $@ || 'Zombie error';
114
ok($ok, "serializing tied scalar did not die")
115
or note("Error was '$err'");
116
ok(defined $out, "serializing tied scalar returns string");
117
118
$ok = eval {$data = decode_sereal($out); 1;};
119
$err = $@ || 'Zombie error';
120
ok($ok, "deserializing tied scalar did not die")
121
or note("Error was '$err', data was:\n"), hobodecode($out);
122
ok(defined $data, "deserializing tied scalar yields defined output");
123
is_deeply($data, \$testscalar, "deserializing tied scalar yields expected output");
96
124
}
97
125
98
my $testscalar = [qw(foo bar baz)];
99
my $tied_scalar;
100
tie $tied_scalar => 'TiedScalar';
101
${tied($tied_scalar)} = $testscalar;
102
is_deeply($tied_scalar, $testscalar);
103
104
$ok = eval {$out = encode_sereal(\$tied_scalar); 1};
105
$err = $@ || 'Zombie error';
106
ok($ok, "serializing tied scalar did not die")
107
or note("Error was '$err'");
108
ok(defined $out, "serializing tied scalar returns string");
109
110
$ok = eval {$data = decode_sereal($out); 1;};
111
$err = $@ || 'Zombie error';
112
ok($ok, "deserializing tied scalar did not die")
113
or note("Error was '$err', data was:\n"), hobodecode($out);
114
ok(defined $data, "deserializing tied scalar yields defined output");
115
is_deeply($data, \$testscalar, "deserializing tied scalar yields expected output");
116
117
118
126
# Now test re-entrancy. DO NOT DO THIS AT HOME!
119
127
SCOPE: {
120
128
my $enc = Sereal::Encoder->new;
Loggerhead is a web-based interface for Breezy
Version: 2.0.1