X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F71mysql.t;h=f78948cfac68bde36173dfaacd36baffc9ffd826;hb=bb7950c01d6b21cf8fe6257e57695f4e6dc74077;hp=5c5d53c9f0655961a7c9a245bbac1fb02074b61d;hpb=e0d56e264fe10386710097fd1ec62fba37179d50;p=dbsrgits%2FDBIx-Class.git diff --git a/t/71mysql.t b/t/71mysql.t index 5c5d53c..f78948c 100644 --- a/t/71mysql.t +++ b/t/71mysql.t @@ -1,13 +1,20 @@ use strict; -use warnings; +use warnings; use Test::More; use Test::Exception; + +use DBI::Const::GetInfoType; +use Scalar::Util qw/weaken/; +use DBIx::Class::Optional::Dependencies (); + use lib qw(t/lib); use DBICTest; -use DBI::Const::GetInfoType; use DBIC::SqlMakerTest; +plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mysql') + unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mysql'); + my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; #warn "$dsn $user $pass"; @@ -75,6 +82,26 @@ $it->next; $it->next; is( $it->next, undef, "next past end of resultset ok" ); +# Limit with select-lock +lives_ok { + $schema->txn_do (sub { + isa_ok ( + $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}), + 'DBICTest::Schema::Artist', + ); + }); +} 'Limited FOR UPDATE select works'; + +# shared-lock +lives_ok { + $schema->txn_do (sub { + isa_ok ( + $schema->resultset('Artist')->find({artistid => 1}, {for => 'shared'}), + 'DBICTest::Schema::Artist', + ); + }); +} 'LOCK IN SHARE MODE select works'; + my $test_type_info = { 'artistid' => { 'data_type' => 'INT', @@ -194,6 +221,29 @@ lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die'; ); } +{ + # Test support for straight joins + my $cdsrc = $schema->source('CD'); + my $artrel_info = $cdsrc->relationship_info ('artist'); + $cdsrc->add_relationship( + 'straight_artist', + $artrel_info->{class}, + $artrel_info->{cond}, + { %{$artrel_info->{attrs}}, join_type => 'straight' }, + ); + is_same_sql_bind ( + $cdsrc->resultset->search({}, { prefetch => 'straight_artist' })->as_query, + '( + SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, + straight_artist.artistid, straight_artist.name, straight_artist.rank, straight_artist.charfield + FROM cd me + STRAIGHT_JOIN artist straight_artist ON straight_artist.artistid = me.artist + )', + [], + 'straight joins correctly supported for mysql' + ); +} + ## Can we properly deal with the null search problem? ## ## Only way is to do a SET SQL_AUTO_IS_NULL = 0; on connect @@ -225,6 +275,34 @@ NULLINSEARCH: { => 'Nothing Found!'; } +# check for proper grouped counts +{ + my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { + on_connect_call => 'set_strict_mode', + quote_char => '`', + }); + my $rs = $ansi_schema->resultset('CD'); + + my $years; + $years->{$_->year|| scalar keys %$years}++ for $rs->all; # NULL != NULL, thus the keys eval + + lives_ok ( sub { + is ( + $rs->search ({}, { group_by => 'year'})->count, + scalar keys %$years, + 'grouped count correct', + ); + }, 'Grouped count does not throw'); + + lives_ok( sub { + $ansi_schema->resultset('Owners')->search({}, { + join => 'books', group_by => [ 'me.id', 'books.id' ] + })->count(); + }, 'count on grouped columns with the same name does not throw'); + + +} + ZEROINSEARCH: { my $cds_per_year = { 2001 => 2, @@ -243,11 +321,11 @@ ZEROINSEARCH: { is ($rs->count, 6, 'CDs created successfully'); $rs = $rs->search ({}, { - select => [ {year => 'year'} ], as => ['y'], distinct => 1, order_by => 'year', + select => [ \ 'YEAR(year)' ], as => ['y'], distinct => 1, }); is_deeply ( - [ $rs->get_column ('y')->all ], + [ sort ($rs->get_column ('y')->all) ], [ sort keys %$cds_per_year ], 'Years group successfully', ); @@ -255,7 +333,7 @@ ZEROINSEARCH: { $rs->create ({ artist => 1, year => '0-1-1', title => 'Jesus Rap' }); is_deeply ( - [ $rs->get_column ('y')->all ], + [ sort $rs->get_column ('y')->all ], [ 0, sort keys %$cds_per_year ], 'Zero-year groups successfully', ); @@ -273,13 +351,78 @@ ZEROINSEARCH: { ); } -## If find() is the first query after connect() -## DBI::Storage::sql_maker() will be called before -## _determine_driver() and so the ::SQLHacks class for MySQL -## will not be used +# make sure find hooks determine driver +{ + my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + $schema->resultset("Artist")->find(4); + isa_ok($schema->storage->sql_maker, 'DBIx::Class::SQLMaker::MySQL'); +} + +# make sure the mysql_auto_reconnect buggery is avoided +{ + local $ENV{MOD_PERL} = 'boogiewoogie'; + my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + ok (! $schema->storage->_get_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect unset regardless of ENV' ); + + # Make sure hardcore forking action still works even if mysql_auto_reconnect + # is true (test inspired by ether) + + my $schema_autorecon = DBICTest::Schema->connect($dsn, $user, $pass, { mysql_auto_reconnect => 1 }); + my $orig_dbh = $schema_autorecon->storage->_get_dbh; + weaken $orig_dbh; + + ok ($orig_dbh, 'Got weak $dbh ref'); + ok ($orig_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect is properly set if explicitly requested' ); + + my $rs = $schema_autorecon->resultset('Artist'); + + my $pid = fork(); + if (! defined $pid ) { + die "fork() failed: $!" + } + elsif ($pid) { + # sanity check + $schema_autorecon->storage->dbh_do(sub { + is ($_[1], $orig_dbh, 'Storage holds correct $dbh in parent'); + }); + + # kill our $dbh + $schema_autorecon->storage->_dbh(undef); -my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); -$schema2->resultset("Artist")->find(4); -isa_ok($schema2->storage->sql_maker, 'DBIx::Class::SQLAHacks::MySQL'); + TODO: { + local $TODO = "Perl $] is known to leak like a sieve" + if DBIx::Class::_ENV_::PEEPEENESS(); + + ok (! defined $orig_dbh, 'Parent $dbh handle is gone'); + } + } + else { + # wait for parent to kill its $dbh + sleep 1; + + #simulate a subtest to not confuse the parent TAP emission + Test::More->builder->reset; + Test::More->builder->plan('no_plan'); + Test::More->builder->_indent(' ' x 4); + + # try to do something dbic-esque + $rs->create({ name => "Hardcore Forker $$" }); + + + TODO: { + local $TODO = "Perl $] is known to leak like a sieve" + if DBIx::Class::_ENV_::PEEPEENESS(); + + ok (! defined $orig_dbh, 'DBIC operation triggered reconnect - old $dbh is gone'); + } + + exit 0; + } + + wait; + ok(!$?, 'Child subtests passed'); + + ok ($rs->find({ name => "Hardcore Forker $pid" }), 'Expected row created'); +} done_testing;