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

minor: Move session tests to normal test directory #161

Closed
wants to merge 2 commits into from
Closed

minor: Move session tests to normal test directory #161

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
b86bf24
minor: Updated PERL-790 test from old BSONDebug role to new command
TBSliver Jun 4, 2018
9235c08
minor: Move all session tests to normal test dir and use monitoring
TBSliver Jun 5, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 23 additions & 29 deletions devel/t-dynamic/PERL-790-cursor-sessions.t → t/sessions-cursors.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,11 +28,6 @@ use MongoDB;
use MongoDB::Error;

use lib "t/lib";
use lib "devel/lib";

use if $ENV{MONGOVERBOSE}, qw/Log::Any::Adapter Stderr/;

use MongoDBTest::Orchestrator;

use MongoDBTest qw/
build_client
Expand All @@ -44,16 +39,15 @@ use MongoDBTest qw/
uuid_to_string
/;

my $orc =
MongoDBTest::Orchestrator->new(
config_file => "devel/config/replicaset-single-3.6.yml" );
$orc->start;

$ENV{MONGOD} = $orc->as_uri;
my @events;

print $ENV{MONGOD};
sub clear_events { @events = () }
sub event_count { scalar @events }
sub event_cb { push @events, $_[0] }

my $conn = build_client();
my $conn = build_client(
monitoring_callback => \&event_cb,
);
my $testdb = get_test_db($conn);
my $server_version = server_version($conn);
my $server_type = server_type($conn);
Expand All @@ -62,15 +56,15 @@ my $coll = $testdb->get_collection('test_collection');
plan skip_all => "Requires MongoDB 3.6"
if $server_version < v3.6.0;

use Test::Role::BSONDebug;
plan skip_all => "Sessions unsupported on standalone server"
if $server_type eq 'Standalone';

Role::Tiny->apply_roles_to_package(
'BSON', 'Test::Role::BSONDebug',
);
plan skip_all => "deployment does not support sessions"
unless $conn->_topology->_supports_sessions;

$coll->insert_many( [ map { { wanted => 1, score => $_ } } 0 .. 400 ] );

Test::Role::BSONDebug::CLEAR_ENCODE_ONE_QUEUE;
clear_events();

subtest 'Shared session in explicit cursor' => sub {

Expand All @@ -83,9 +77,9 @@ subtest 'Shared session in explicit cursor' => sub {

my $lsid = uuid_to_string( $session->_server_session->session_id->{id}->data );

my $cursor_command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $cursor_command = $events[-2]->{ command };

my $cursor_command_sid = uuid_to_string( $cursor_command->FETCH('lsid')->{id}->data );
my $cursor_command_sid = uuid_to_string( $cursor_command->{'lsid'}->{id}->data );

is $cursor_command_sid, $lsid, "Cursor sent with correct lsid";

Expand All @@ -97,9 +91,9 @@ subtest 'Shared session in explicit cursor' => sub {
# Call first batch run outside of loop as doesnt fetch intially
my @items = $cursor->batch;
while ( @items = $cursor->batch ) {
my $command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
ok $command->EXISTS('lsid'), "cursor has session";
my $cursor_session_id = uuid_to_string( $command->FETCH('lsid')->{id}->data );
my $command = $events[-2]->{ command };
ok exists $command->{'lsid'}, "cursor has session";
my $cursor_session_id = uuid_to_string( $command->{'lsid'}->{id}->data );
is $cursor_session_id, $lsid, "Cursor is using given session";
}
};
Expand All @@ -114,7 +108,7 @@ subtest 'Shared session in explicit cursor' => sub {

};

Test::Role::BSONDebug::CLEAR_ENCODE_ONE_QUEUE;
clear_events();

subtest 'Shared session in implicit cursor' => sub {

Expand All @@ -123,19 +117,19 @@ subtest 'Shared session in implicit cursor' => sub {
# pull out implicit session
my $lsid = uuid_to_string( $cursor->_session->session_id->{id}->data );

my $cursor_command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $cursor_command = $events[-2]->{ command };

my $cursor_command_sid = uuid_to_string( $cursor_command->FETCH('lsid')->{id}->data );
my $cursor_command_sid = uuid_to_string( $cursor_command->{'lsid'}->{id}->data );

is $cursor_command_sid, $lsid, "Cursor sent with correct lsid";

subtest 'All cursor calls in same session' => sub {
# Call first batch run outside of loop as doesnt fetch intially
my @items = $cursor->batch;
while ( @items = $cursor->batch ) {
my $command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
ok $command->EXISTS('lsid'), "cursor has session";
my $cursor_session_id = uuid_to_string( $command->FETCH('lsid')->{id}->data );
my $command = $events[-2]->{ command };
ok exists $command->{'lsid'}, "cursor has session";
my $cursor_session_id = uuid_to_string( $command->{'lsid'}->{id}->data );
is $cursor_session_id, $lsid, "Cursor is using given session";
}
};
Expand Down
104 changes: 45 additions & 59 deletions devel/t-dynamic/PERL-790-driver-sessions.t → t/sessions-driver.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,11 +27,6 @@ use MongoDB;
use MongoDB::Error;

use lib "t/lib";
use lib "devel/lib";

use if $ENV{MONGOVERBOSE}, qw/Log::Any::Adapter Stderr/;

use MongoDBTest::Orchestrator;

use MongoDBTest qw/
build_client
Expand All @@ -42,19 +37,15 @@ use MongoDBTest qw/
get_unique_collection
/;

# This test starts servers on localhost ports 27017, 27018 and 27019. We skip if
# these aren't available.

my $orc =
MongoDBTest::Orchestrator->new(
config_file => "devel/config/replicaset-single-3.6.yml" );
$orc->start;
my @events;

$ENV{MONGOD} = $orc->as_uri;
sub clear_events { @events = () }
sub event_count { scalar @events }
sub event_cb { push @events, $_[0] }

print $ENV{MONGOD};

my $conn = build_client();
my $conn = build_client(
monitoring_callback => \&event_cb,
);
my $testdb = get_test_db($conn);
my $server_version = server_version($conn);
my $server_type = server_type($conn);
Expand All @@ -63,6 +54,12 @@ my $coll = $testdb->get_collection('test_collection');
plan skip_all => "Requires MongoDB 3.6"
if $server_version < v3.6.0;

plan skip_all => "Sessions unsupported on standalone server"
if $server_type eq 'Standalone';

plan skip_all => "deployment does not support sessions"
unless $conn->_topology->_supports_sessions;

# Last in First out
subtest 'LIFO Pool' => sub {
my $session_a = $conn->start_session;
Expand Down Expand Up @@ -92,35 +89,28 @@ subtest 'LIFO Pool' => sub {

subtest 'clusterTime in commands' => sub {

use Test::Role::BSONDebug;

Role::Tiny->apply_roles_to_package(
'BSON', 'Test::Role::BSONDebug',
);

subtest 'ping' => sub {
my $local_client = get_high_heartbeat_client();

my $ping_result = $local_client->send_admin_command(Tie::IxHash->new('ping' => 1));

my $command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $result = Test::Role::BSONDebug::GET_LAST_DECODE_ONE;
my $command = $events[-2]->{ command };
my $result = $events[-1]->{ reply };

ok $command->EXISTS('ping'), 'ping in sent command';
ok exists $command->{'ping'}, 'ping in sent command';

ok $command->EXISTS('$clusterTime'), 'clusterTime in sent command';
ok exists $command->{'$clusterTime'}, 'clusterTime in sent command';

my $ping_result2 = $local_client->send_admin_command(Tie::IxHash->new('ping' => 1));

my $command2 = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $command2 = $events[-2]->{ command };

is $command2->FETCH('$clusterTime')->{clusterTime}->{sec},
$result->{'$clusterTime'}->{clusterTime}->{sec},
ok $command2->{'$clusterTime'}->{clusterTime}
== $result->{'$clusterTime'}->{clusterTime},
"clusterTime matches";
};

Test::Role::BSONDebug::CLEAR_ENCODE_ONE_QUEUE;
Test::Role::BSONDebug::CLEAR_DECODE_ONE_QUEUE;
clear_events();

subtest 'aggregate' => sub {
my $local_client = get_high_heartbeat_client();
Expand All @@ -140,25 +130,24 @@ subtest 'clusterTime in commands' => sub {
{ '$group' => { _id => 1, 'avgScore' => { '$avg' => '$score' } } }
] );

my $command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $result = Test::Role::BSONDebug::GET_LAST_DECODE_ONE;
my $command = $events[-2]->{ command };
my $result = $events[-1]->{ reply };

ok $command->EXISTS('aggregate'), 'aggregate in sent command';
ok exists $command->{'aggregate'}, 'aggregate in sent command';

ok $command->EXISTS('$clusterTime'), 'clusterTime in sent command';
ok exists $command->{'$clusterTime'}, 'clusterTime in sent command';

my $agg_result2 = $local_coll->aggregate( [ { '$match' => { wanted => 1 } },
{ '$group' => { _id => 1, 'avgScore' => { '$avg' => '$score' } } } ] );

my $command2 = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $command2 = $events[-2]->{ command };

is $command2->FETCH('$clusterTime')->{clusterTime}->{sec},
$result->{'$clusterTime'}->{clusterTime}->{sec},
ok $command2->{'$clusterTime'}->{clusterTime}
== $result->{'$clusterTime'}->{clusterTime},
"clusterTime matches";
};

Test::Role::BSONDebug::CLEAR_ENCODE_ONE_QUEUE;
Test::Role::BSONDebug::CLEAR_DECODE_ONE_QUEUE;
clear_events();

subtest 'find' => sub {
my $local_client = get_high_heartbeat_client();
Expand All @@ -171,24 +160,23 @@ subtest 'clusterTime in commands' => sub {
# explain 1 to get it to show the whole returned result
my $find_result = $local_coll->find({_id => 1})->result;

my $command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $result = Test::Role::BSONDebug::GET_LAST_DECODE_ONE;
my $command = $events[-2]->{ command };
my $result = $events[-1]->{ reply };

ok $command->EXISTS('find'), 'find in sent command';
ok exists $command->{'find'}, 'find in sent command';

ok $command->EXISTS('$clusterTime'), 'clusterTime in sent command';
ok exists $command->{'$clusterTime'}, 'clusterTime in sent command';

my $find_result2 = $local_coll->find({_id => 1})->result;

my $command2 = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $command2 = $events[-2]->{ command };

is $command2->FETCH('$clusterTime')->{clusterTime}->{sec},
$result->{'$clusterTime'}->{clusterTime}->{sec},
ok $command2->{'$clusterTime'}->{clusterTime}
== $result->{'$clusterTime'}->{clusterTime},
"clusterTime matches";
};

Test::Role::BSONDebug::CLEAR_ENCODE_ONE_QUEUE;
Test::Role::BSONDebug::CLEAR_DECODE_ONE_QUEUE;
clear_events();

subtest 'insert_one' => sub {
my $local_client = get_high_heartbeat_client();
Expand All @@ -197,30 +185,28 @@ subtest 'clusterTime in commands' => sub {

my $insert_result = $local_coll->insert_one({_id => 1});

my $command = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $result = Test::Role::BSONDebug::GET_LAST_DECODE_ONE;
my $command = $events[-2]->{ command };
my $result = $events[-1]->{ reply };

ok $command->EXISTS('insert'), 'insert in sent command';
ok exists $command->{'insert'}, 'insert in sent command';

ok $command->EXISTS('$clusterTime'), 'clusterTime in sent command';
ok exists $command->{'$clusterTime'}, 'clusterTime in sent command';

my $insert_result2 = $local_coll->insert_one({_id => 2});

my $command2 = Test::Role::BSONDebug::GET_LAST_ENCODE_ONE;
my $command2 = $events[-2]->{ command };

is $command2->FETCH('$clusterTime')->{clusterTime}->{sec},
$result->{'$clusterTime'}->{clusterTime}->{sec},
ok $command2->{'$clusterTime'}->{clusterTime}
== $result->{'$clusterTime'}->{clusterTime},
"clusterTime matches";
};

Test::Role::BSONDebug::CLEAR_ENCODE_ONE_QUEUE;
Test::Role::BSONDebug::CLEAR_DECODE_ONE_QUEUE;
};

sub get_high_heartbeat_client {
my $local_client = build_client(
# You want big number? we give you big number
heartbeat_frequency_ms => 9_000_000_000,
monitoring_callback => \&event_cb,
);

# Make sure we have clusterTime already populated
Expand Down
35 changes: 15 additions & 20 deletions devel/t-dynamic/PERL-790-end-sessions.t → t/sessions-end.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,11 +29,6 @@ use MongoDB;
use MongoDB::Error;

use lib "t/lib";
use lib "devel/lib";

use if $ENV{MONGOVERBOSE}, qw/Log::Any::Adapter Stderr/;

use MongoDBTest::Orchestrator;

use MongoDBTest qw/
build_client
Expand All @@ -45,21 +40,15 @@ use MongoDBTest qw/
uuid_to_string
/;

use Test::Role::BSONDebug;
Role::Tiny->apply_roles_to_package(
'BSON', 'Test::Role::BSONDebug',
);

my $orc =
MongoDBTest::Orchestrator->new(
config_file => "devel/config/replicaset-single-3.6.yml" );
$orc->start;
my @events;

$ENV{MONGOD} = $orc->as_uri;
sub clear_events { @events = () }
sub event_count { scalar @events }
sub event_cb { push @events, $_[0] }

print $ENV{MONGOD};

my $conn = build_client();
my $conn = build_client(
monitoring_callback => \&event_cb,
);
my $testdb = get_test_db($conn);
my $server_version = server_version($conn);
my $server_type = server_type($conn);
Expand All @@ -68,6 +57,12 @@ my $coll = $testdb->get_collection('test_collection');
plan skip_all => "Requires MongoDB 3.6"
if $server_version < v3.6.0;

plan skip_all => "Sessions unsupported on standalone server"
if $server_type eq 'Standalone';

plan skip_all => "deployment does not support sessions"
unless $conn->_topology->_supports_sessions;

subtest 'endSession closes sessions on server' => sub {
my $session_count = 10;
my @sessions;
Expand Down Expand Up @@ -109,9 +104,9 @@ subtest 'endSession closes sessions on server' => sub {
# called in destruction of client normally
$conn->_server_session_pool->end_all_sessions;

my $response = Test::Role::BSONDebug::GET_LAST_DECODE_ONE;
my $response = $events[-1];

is $response->{ok}, 1, 'Got ok 1 from ending all sessions';
is $response->{reply}->{ok}, 1, 'Got ok 1 from ending all sessions';

};

Expand Down
Loading