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
|
# Copyright 2015 - present MongoDB, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
use strict;
use warnings;
use Config;
use if $Config{usethreads}, 'threads';
use Test::More;
BEGIN {
plan skip_all => 'requires threads' unless $Config{usethreads};
plan skip_all => 'needs Perl 5.10.1' unless $] ge '5.010001';
}
use MongoDB;
use Try::Tiny;
use threads::shared;
use lib "t/lib";
my $class = "BSON";
require_ok($class);
my $codec = $class->new;
my $var = { a => "x" };
my $clone = shared_clone $var;
my $enc_var = $codec->encode_one($var);
my $enc_clone = $codec->encode_one($clone);
_bson_is( $enc_var, $enc_clone,
"encoded top level hash and encoded top level shared hash" );
_bson_is(
$codec->encode_one( { data => $var } ),
$codec->encode_one( { data => $clone } ),
"encoded hash and encoded shared hash"
);
_bson_is(
$codec->encode_one( { data => $var->{a} } ),
$codec->encode_one( { data => $clone->{a} } ),
"encoded double and encoded shared clone of double"
);
threads->create(
sub {
_bson_is(
$codec->encode_one($var),
$codec->encode_one($clone),
"(in thread) encoded top level hash and encoded top level shared hash"
);
_bson_is(
$codec->encode_one( { data => $var } ),
$codec->encode_one( { data => $clone } ),
"(in thread) encoded hash and encoded shared hash"
);
_bson_is(
$codec->encode_one( { data => $var->{a} } ),
$codec->encode_one( { data => $clone->{a} } ),
"(in thread) encoded double and encoded shared clone of double"
);
}
)->join;
sub _bson_is {
my ( $got, $exp, $label ) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
ok( $got eq $exp, $label )
or diag " Got:", _hexdump($got), "\nExpected:", _hexdump($exp), "\n";
}
sub _hexdump {
my $str = shift;
my $out = unpack("H*", $str);
return $out;
}
done_testing();
|
