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
85
86
87
88
89
90
91
92
93
94
95
|
#!perl
use strict;
use warnings;
use Data::Dumper;
use File::Spec;
# These tests use an installed Encoder.
# Purpose: See if we correctly set overload magic on deserialized
# objects in funny circumstances.
use lib File::Spec->catdir(qw(t lib));
BEGIN {
lib->import('lib')
if !-d 't';
}
use Sereal::TestSet qw(:all);
use Test::More;
use Sereal::Decoder;
my $ok= have_encoder_and_decoder();
if ( not $ok ) {
plan skip_all => 'Did not find right version of encoder';
done_testing();
exit(0);
}
require Sereal::Encoder;
my $encoder= Sereal::Encoder->new( {
stringify_unknown => 1,
warn_unknown => 1,
} );
# encode before any overload is known
my $s= $encoder->encode( bless( { foo => "123" } => "Str" ) );
my $decoder= Sereal::Decoder->new();
# "load" the object's class
eval <<'HERE';
package Str;
use vars '$Called';
$Called = 0;
use overload '""' => sub {
$Called++;
return $_[0]->{foo};
};
HERE
# decode object
# Yves: Move this to where the class wasn't loaded yet, and the tests fail
# (which indicates overload hooking into bless and adding magic to the
# object {{citation required}})
my $obj= $decoder->decode($s);
# FOR YVES:
#use Devel::Peek;
#Dump($obj);
# see if overload magic is on object
is( "$obj", 123, "Deserialized object serializes fine" );
$Str::Called= $Str::Called; # silence warning
is( $Str::Called, 1, "overload invoked once" );
# Second try at breaking things
SCOPE: {
my $enc= Sereal::Encoder->new( {
warn_unknown => 1,
stringify_unknown => 1,
} );
my $dec= Sereal::Decoder->new;
package Foo;
use overload '""' => sub { return $_[0]->{str} };
package main;
my $p= bless( { str => "asd" } => 'Foo' );
my $h= [ $p, $p ];
my $s= $enc->encode($h);
my $d= $dec->decode($s);
#warn "$_" for @$d;
my $x= join ",", @$d;
is( $x, "asd,asd", "overload stringification works for second object occurrence" );
#warn $x;
}
pass("Alive");
done_testing();
|
