Skip to content
This repository was archived by the owner on Dec 22, 2021. It is now read-only.

Commit a61a791

Browse files
committed
PERL-784: Added t-dynamic test for issue
1 parent acb73e1 commit a61a791

File tree

1 file changed

+92
-0
lines changed

1 file changed

+92
-0
lines changed
Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
#
2+
# Copyright 2014 MongoDB, Inc.
3+
#
4+
# Licensed under the Apache License, Version 2.0 (the "License");
5+
# you may not use this file except in compliance with the License.
6+
# You may obtain a copy of the License at
7+
#
8+
# http://www.apache.org/licenses/LICENSE-2.0
9+
#
10+
# Unless required by applicable law or agreed to in writing, software
11+
# distributed under the License is distributed on an "AS IS" BASIS,
12+
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13+
# See the License for the specific language governing permissions and
14+
# limitations under the License.
15+
#
16+
17+
use strict;
18+
use warnings;
19+
use utf8;
20+
use Test::More 0.88;
21+
use Test::Fatal;
22+
use Test::Deep qw/!blessed/;
23+
use Try::Tiny;
24+
use boolean;
25+
26+
use MongoDB;
27+
use MongoDB::Error;
28+
29+
use lib "t/lib";
30+
use lib "devel/lib";
31+
32+
use if $ENV{MONGOVERBOSE}, qw/Log::Any::Adapter Stderr/;
33+
34+
use MongoDBTest::Orchestrator;
35+
use MongoDBTest qw/build_client get_test_db clear_testdbs/;
36+
37+
sub _get_orphan_chunks {
38+
my ($db) = @_;
39+
40+
my @f_ids = $db->get_collection('fs.files')->distinct('_id')->all;
41+
42+
my @orphans = $db->get_collection('fs.chunks')->find({
43+
files_id => { '$nin' => \@f_ids }
44+
}, {
45+
projection => { _id => 1}
46+
})->all;
47+
return @orphans;
48+
}
49+
50+
sub _test_orphan_chunks {
51+
52+
local $Test::Builder::Level = $Test::Builder::Level + 1;
53+
my $conn = build_client( dt_type => undef );
54+
my $testdb = get_test_db($conn);
55+
56+
my $coll = $testdb->get_collection('fs.files');
57+
58+
my $file_indexes = $testdb->get_collection('fs.files')->indexes;
59+
60+
$file_indexes->create_one([tst =>1], {unique => 1});
61+
62+
my $gridfs = $testdb->get_gridfs;
63+
my $duplicate_meta = {
64+
tst => 'this_will_break'
65+
};
66+
67+
my $test_file = "t/data/gridfs/data.bin";
68+
open (my $fh, '<:raw', $test_file) or die $!;
69+
try{
70+
$gridfs->insert($fh, $duplicate_meta);
71+
$gridfs->insert($fh, $duplicate_meta);
72+
} catch {};
73+
close ($fh);
74+
75+
my @orphan_chunks = _get_orphan_chunks($testdb);
76+
77+
is(scalar @orphan_chunks, 0, "orphan chunks found");
78+
}
79+
80+
subtest "wire protocol 3" => sub {
81+
my $orc =
82+
MongoDBTest::Orchestrator->new( config_file => "devel/config/mongod-3.4.yml" );
83+
diag "starting deployment";
84+
$orc->start;
85+
local $ENV{MONGOD} = $orc->as_uri;
86+
87+
_test_orphan_chunks();
88+
};
89+
90+
clear_testdbs;
91+
92+
done_testing;

0 commit comments

Comments
 (0)