X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F746sybase.t;h=677d78ad4b48b70ad82346a44d1c6c1ca0197512;hb=26283ee38f220f6c6bae720ea5a189c9c0f47f6f;hp=1e5eeaaaca6e3783ab2341bce4b6e29213fe3337;hpb=7ef97d266d92f1239f075f079cb94f20e31fa3d6;p=dbsrgits%2FDBIx-Class.git diff --git a/t/746sybase.t b/t/746sybase.t index 1e5eeaa..677d78a 100644 --- a/t/746sybase.t +++ b/t/746sybase.t @@ -1,482 +1,91 @@ use strict; -use warnings; -no warnings 'uninitialized'; +use warnings; use Test::More; use Test::Exception; use lib qw(t/lib); - -BEGIN { - require DBICTest::Schema::BindType; - DBICTest::Schema::BindType->add_column( - anint => { data_type => 'integer' } - ); -} - use DBICTest; -require DBIx::Class::Storage::DBI::Sybase; -require DBIx::Class::Storage::DBI::Sybase::NoBindVars; - my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; -my $TESTS = 51 + 2; - -if (not ($dsn && $user)) { - plan skip_all => - 'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test' . - "\nWarning: This test drops and creates the tables " . - "'artist', 'money_test' and 'bindtype_test'"; -} else { - plan tests => $TESTS*2 + 1; -} - -my @storage_types = ( - 'DBI::Sybase', - 'DBI::Sybase::NoBindVars', -); -my $schema; -my $storage_idx = -1; - -sub get_schema { - DBICTest::Schema->connect($dsn, $user, $pass, { - on_connect_call => [ - [ blob_setup => log_on_update => 1 ], # this is a safer option - ], - }); -} - -my $ping_count = 0; -{ - my $ping = DBIx::Class::Storage::DBI::Sybase->can('_ping'); - *DBIx::Class::Storage::DBI::Sybase::_ping = sub { - $ping_count++; - goto $ping; - }; -} - -for my $storage_type (@storage_types) { - $storage_idx++; +plan skip_all => 'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test' + unless ($dsn && $user); - unless ($storage_type eq 'DBI::Sybase') { # autodetect - DBICTest::Schema->storage_type("::$storage_type"); - } +plan tests => 13; - $schema = get_schema(); +my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1}); - $schema->storage->ensure_connected; +# start disconnected to test reconnection +$schema->storage->ensure_connected; +$schema->storage->_dbh->disconnect; - if ($storage_idx == 0 && - $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::NoBindVars')) { -# no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS) - my $tb = Test::More->builder; - $tb->skip('no placeholders') for 1..$TESTS; - next; - } +isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::Sybase' ); - isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" ); +my $dbh; +lives_ok (sub { + $dbh = $schema->storage->dbh; +}, 'reconnect works'); - $schema->storage->_dbh->disconnect; - lives_ok (sub { $schema->storage->dbh }, 'reconnect works'); +$schema->storage->dbh_do (sub { + my ($storage, $dbh) = @_; + eval { $dbh->do("DROP TABLE artist") }; + $dbh->do(<<'SQL'); - $schema->storage->dbh_do (sub { - my ($storage, $dbh) = @_; - eval { $dbh->do("DROP TABLE artist") }; - $dbh->do(<<'SQL'); CREATE TABLE artist ( - artistid INT IDENTITY PRIMARY KEY, + artistid INT IDENTITY NOT NULL, name VARCHAR(100), rank INT DEFAULT 13 NOT NULL, - charfield CHAR(10) NULL + charfield CHAR(10) NULL, + primary key(artistid) ) -SQL - }); - - my %seen_id; -# so we start unconnected - $schema->storage->disconnect; +SQL -# test primary key handling - my $new = $schema->resultset('Artist')->create({ name => 'foo' }); - ok($new->artistid > 0, "Auto-PK worked"); +}); - $seen_id{$new->artistid}++; +my %seen_id; -# check redispatch to storage-specific insert when auto-detected storage - if ($storage_type eq 'DBI::Sybase') { - DBICTest::Schema->storage_type('::DBI'); - $schema = get_schema(); - } +# fresh $schema so we start unconnected +$schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1}); - $new = $schema->resultset('Artist')->create({ name => 'Artist 1' }); - is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' ); - $seen_id{$new->artistid}++; +# test primary key handling +my $new = $schema->resultset('Artist')->create({ name => 'foo' }); +ok($new->artistid > 0, "Auto-PK worked"); -# inserts happen in a txn, so we make sure it still works inside a txn too - $schema->txn_begin; +$seen_id{$new->artistid}++; - for (2..6) { +# test LIMIT support +for (1..6) { $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" ); $seen_id{$new->artistid}++; - } - - $schema->txn_commit; - -# test simple count - is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok'); - -# test LIMIT support - my $it = $schema->resultset('Artist')->search({ - artistid => { '>' => 0 } - }, { - rows => 3, - order_by => 'artistid', - }); - - is( $it->count, 3, "LIMIT count ok" ); +} - is( $it->next->name, "foo", "iterator->next ok" ); - $it->next; - is( $it->next->name, "Artist 2", "iterator->next ok" ); - is( $it->next, undef, "next past end of resultset ok" ); +my $it; -# now try with offset - $it = $schema->resultset('Artist')->search({}, { +$it = $schema->resultset('Artist')->search( {}, { rows => 3, - offset => 3, order_by => 'artistid', - }); - - is( $it->count, 3, "LIMIT with offset count ok" ); - - is( $it->next->name, "Artist 3", "iterator->next ok" ); - $it->next; - is( $it->next->name, "Artist 5", "iterator->next ok" ); - is( $it->next, undef, "next past end of resultset ok" ); - -# now try a grouped count - $schema->resultset('Artist')->create({ name => 'Artist 6' }) - for (1..6); - - $it = $schema->resultset('Artist')->search({}, { - group_by => 'name' - }); - - is( $it->count, 7, 'COUNT of GROUP_BY ok' ); - -# do an IDENTITY_INSERT - { - no warnings 'redefine'; - - my @debug_out; - local $schema->storage->{debug} = 1; - local $schema->storage->debugobj->{callback} = sub { - push @debug_out, $_[1]; - }; - - my $txn_used = 0; - my $txn_commit = \&DBIx::Class::Storage::DBI::txn_commit; - local *DBIx::Class::Storage::DBI::txn_commit = sub { - $txn_used = 1; - goto &$txn_commit; - }; - - $schema->resultset('Artist') - ->create({ artistid => 999, name => 'mtfnpy' }); - - ok((grep /IDENTITY_INSERT/i, @debug_out), 'IDENTITY_INSERT used'); - - SKIP: { - skip 'not testing lack of txn on IDENTITY_INSERT with NoBindVars', 1 - if $storage_type =~ /NoBindVars/i; - - is $txn_used, 0, 'no txn on insert with IDENTITY_INSERT'; - } - } - -# do an IDENTITY_UPDATE - { - my @debug_out; - local $schema->storage->{debug} = 1; - local $schema->storage->debugobj->{callback} = sub { - push @debug_out, $_[1]; - }; - - lives_and { - $schema->resultset('Artist') - ->find(999)->update({ artistid => 555 }); - ok((grep /IDENTITY_UPDATE/i, @debug_out)); - } 'IDENTITY_UPDATE used'; - $ping_count-- if $@; - } - - -# test insert_bulk using populate, this should always pass whether or not it -# does anything Sybase specific or not. Just here to aid debugging. - lives_ok { - $schema->resultset('Artist')->populate([ - { - name => 'bulk artist 1', - charfield => 'foo', - }, - { - name => 'bulk artist 2', - charfield => 'foo', - }, - { - name => 'bulk artist 3', - charfield => 'foo', - }, - ]); - } 'insert_bulk via populate'; - - my $bulk_rs = $schema->resultset('Artist')->search({ - name => { -like => 'bulk artist %' } - }); - - is $bulk_rs->count, 3, 'correct number inserted via insert_bulk'; +}); - is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3, - 'column set correctly via insert_bulk'); +TODO: { + local $TODO = 'Sybase is very very fucked in the limit department'; - my %bulk_ids; - @bulk_ids{map $_->artistid, $bulk_rs->all} = (); - - is ((scalar keys %bulk_ids), 3, - 'identities generated correctly in insert_bulk'); - - $bulk_rs->delete; - -# now test insert_bulk with IDENTITY_INSERT - lives_ok { - $schema->resultset('Artist')->populate([ - { - artistid => 2001, - name => 'bulk artist 1', - charfield => 'foo', - }, - { - artistid => 2002, - name => 'bulk artist 2', - charfield => 'foo', - }, - { - artistid => 2003, - name => 'bulk artist 3', - charfield => 'foo', - }, - ]); - } 'insert_bulk with IDENTITY_INSERT via populate'; - - is $bulk_rs->count, 3, - 'correct number inserted via insert_bulk with IDENTITY_INSERT'; - - is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3, - 'column set correctly via insert_bulk with IDENTITY_INSERT'); - - $bulk_rs->delete; - -# test correlated subquery - my $subq = $schema->resultset('Artist')->search({ artistid => { '>' => 3 } }) - ->get_column('artistid') - ->as_query; - my $subq_rs = $schema->resultset('Artist')->search({ - artistid => { -in => $subq } - }); - is $subq_rs->count, 11, 'correlated subquery'; - -# mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t - SKIP: { - skip 'TEXT/IMAGE support does not work with FreeTDS', 16 - if $schema->storage->using_freetds; - - my $dbh = $schema->storage->_dbh; - { - local $SIG{__WARN__} = sub {}; - eval { $dbh->do('DROP TABLE bindtype_test') }; - - $dbh->do(qq[ - CREATE TABLE bindtype_test - ( - id INT IDENTITY PRIMARY KEY, - bytea INT NULL, - blob IMAGE NULL, - clob TEXT NULL, - anint INT NULL - ) - ],{ RaiseError => 1, PrintError => 0 }); - } - - my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); - $binstr{'large'} = $binstr{'small'} x 1024; - - my $maxloblen = length $binstr{'large'}; - - if (not $schema->storage->using_freetds) { - $dbh->{'LongReadLen'} = $maxloblen * 2; - } else { - $dbh->do("set textsize ".($maxloblen * 2)); - } - - my $rs = $schema->resultset('BindType'); - my $last_id; - - foreach my $type (qw(blob clob)) { - foreach my $size (qw(small large)) { - no warnings 'uninitialized'; - - my $created = eval { $rs->create( { $type => $binstr{$size} } ) }; - ok(!$@, "inserted $size $type without dying"); - diag $@ if $@; - - $last_id = $created->id if $created; - - my $got = eval { - $rs->find($last_id)->$type - }; - diag $@ if $@; - ok($got eq $binstr{$size}, "verified inserted $size $type"); - } - } - - # blob insert with explicit PK - # also a good opportunity to test IDENTITY_INSERT - - $rs->delete; - - my $created = eval { $rs->create( { id => 1, blob => $binstr{large} } ) }; - ok(!$@, "inserted large blob without dying with manual PK"); - diag $@ if $@; - - my $got = eval { - $rs->find(1)->blob - }; - diag $@ if $@; - ok($got eq $binstr{large}, "verified inserted large blob with manual PK"); - - # try a blob update - my $new_str = $binstr{large} . 'mtfnpy'; - - # check redispatch to storage-specific update when auto-detected storage - if ($storage_type eq 'DBI::Sybase') { - DBICTest::Schema->storage_type('::DBI'); - $schema = get_schema(); - } - - eval { $rs->search({ id => 1 })->update({ blob => $new_str }) }; - ok !$@, 'updated blob successfully'; - diag $@ if $@; - $got = eval { - $rs->find(1)->blob - }; - diag $@ if $@; - ok($got eq $new_str, "verified updated blob"); - - # try a blob update with IDENTITY_UPDATE - lives_and { - $new_str = $binstr{large} . 'hlagh'; - $rs->find(1)->update({ id => 999, blob => $new_str }); - ok($rs->find(999)->blob eq $new_str); - } 'verified updated blob with IDENTITY_UPDATE'; - - ## try multi-row blob update - # first insert some blobs - $rs->delete; - $rs->create({ blob => $binstr{large} }) for (1..3); - $new_str = $binstr{large} . 'foo'; - $rs->update({ blob => $new_str }); - is((grep $_->blob eq $new_str, $rs->all), 3, 'multi-row blob update'); - - # make sure impossible blob update throws - throws_ok { - $rs->update({ anint => 5 }); - $rs->create({ anint => 6 }); - $rs->search({ anint => 5 })->update({ blob => $new_str, anint => 6 }); - } qr/impossible/, 'impossible blob update throws'; - } - -# test MONEY column support - $schema->storage->dbh_do (sub { - my ($storage, $dbh) = @_; - eval { $dbh->do("DROP TABLE money_test") }; - $dbh->do(<<'SQL'); -CREATE TABLE money_test ( - id INT IDENTITY PRIMARY KEY, - amount MONEY NULL -) -SQL - }); - -# test insert transaction when there's an active cursor - SKIP: { - skip 'not testing insert with active cursor if using ::NoBindVars', 1 - if $storage_type =~ /NoBindVars/i; - - my $artist_rs = $schema->resultset('Artist'); - $artist_rs->first; - lives_ok { - my $row = $schema->resultset('Money')->create({ amount => 100 }); - $row->delete; - } 'inserted a row with an active cursor'; - $ping_count-- if $@; # dbh_do calls ->connected - } - -# test insert in an outer transaction when there's an active cursor - TODO: { - local $TODO = 'this should work once we have eager cursors'; - -# clear state, or we get a deadlock on $row->delete -# XXX figure out why this happens - $schema->storage->disconnect; - - lives_ok { - $schema->txn_do(sub { - my $artist_rs = $schema->resultset('Artist'); - $artist_rs->first; - my $row = $schema->resultset('Money')->create({ amount => 100 }); - $row->delete; - }); - } 'inserted a row with an active cursor in outer txn'; - $ping_count-- if $@; # dbh_do calls ->connected - } - -# Now test money values. - my $rs = $schema->resultset('Money'); - - my $row; - lives_ok { - $row = $rs->create({ amount => 100 }); - } 'inserted a money value'; - - is eval { $rs->find($row->id)->amount }, 100, 'money value round-trip'; - - lives_ok { - $row->update({ amount => 200 }); - } 'updated a money value'; + is( $it->count, 3, "LIMIT count ok" ); +} - is eval { $rs->find($row->id)->amount }, - 200, 'updated money value round-trip'; +# The iterator still works correctly with rows => 3, even though the sql is +# fucked, very interesting. - lives_ok { - $row->update({ amount => undef }); - } 'updated a money value to NULL'; +is( $it->next->name, "foo", "iterator->next ok" ); +$it->next; +is( $it->next->name, "Artist 2", "iterator->next ok" ); +is( $it->next, undef, "next past end of resultset ok" ); - my $null_amount = eval { $rs->find($row->id)->amount }; - ok( - (($null_amount == undef) && (not $@)), - 'updated money value to NULL round-trip' - ); - diag $@ if $@; -} - -is $ping_count, 0, 'no pings'; # clean up our mess END { - if (my $dbh = eval { $schema->storage->_dbh }) { - eval { $dbh->do("DROP TABLE $_") } - for qw/artist bindtype_test money_test/; - } + my $dbh = eval { $schema->storage->_dbh }; + $dbh->do('DROP TABLE artist') if $dbh; } +