X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F746sybase.t;h=91bfb242945717a1f9b6906d78087350b1fe2600;hb=6eedf09afdc5140110c8f9ce108eefd2f7c85959;hp=2eeeb111088ddbafff65a3b429a4cbf37e7f190e;hpb=b0b44f974ad33fb7e2e899dcd844392eb09287d7;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/t/746sybase.t b/t/746sybase.t index 2eeeb11..91bfb24 100644 --- a/t/746sybase.t +++ b/t/746sybase.t @@ -9,13 +9,15 @@ use DBICTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; +my $TESTS = 29 + 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' and 'bindtype_test'"; } else { - plan tests => (27 + 2)*2; + plan tests => $TESTS*2; } my @storage_types = ( @@ -23,8 +25,10 @@ my @storage_types = ( 'DBI::Sybase::NoBindVars', ); my $schema; +my $storage_idx = -1; for my $storage_type (@storage_types) { + $storage_idx++; $schema = DBICTest::Schema->clone; unless ($storage_type eq 'DBI::Sybase') { # autodetect @@ -40,6 +44,14 @@ for my $storage_type (@storage_types) { $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::$storage_type" ); lives_ok (sub { $schema->storage->dbh }, 'reconnect works'); @@ -116,62 +128,91 @@ SQL is( $it->count, 7, 'COUNT of GROUP_BY ok' ); -# mostly stole the blob stuff Nniuq wrote for t/73oracle.t - 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 PRIMARY KEY, - bytea INT NULL, - blob IMAGE NULL, - clob TEXT NULL - ) - ],{ RaiseError => 1, PrintError => 1 }); - } +# mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t + SKIP: { + skip 'TEXT/IMAGE support does not work with FreeTDS', 12 + 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 + ) + ],{ RaiseError => 1, PrintError => 0 }); + } + + my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); + $binstr{'large'} = $binstr{'small'} x 1024; - my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); - $binstr{'large'} = $binstr{'small'} x 1024; + my $maxloblen = length $binstr{'large'}; + note + "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; + local $dbh->{'LongReadLen'} = $maxloblen * 2; - my $maxloblen = length $binstr{'large'}; - note "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; - local $dbh->{'LongReadLen'} = $maxloblen; + my $rs = $schema->resultset('BindType'); + my $last_id; - my $rs = $schema->resultset('BindType'); - my $id = 0; + foreach my $type (qw(blob clob)) { + foreach my $size (qw(small large)) { + no warnings 'uninitialized'; - foreach my $type (qw(blob clob)) { - foreach my $size (qw(small large)) { - no warnings 'uninitialized'; - $id++; + my $created = eval { $rs->create( { $type => $binstr{$size} } ) }; + ok(!$@, "inserted $size $type without dying"); + diag $@ if $@; - eval { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }; - ok(!$@, "inserted $size $type without dying"); - diag $@ if $@; + $last_id = $created->id if $created; - my $got = eval { - $rs->search({ id=> $id }, { select => [$type] })->single->$type - }; - diag $@ if $@; - ok($got eq $binstr{$size}, "verified inserted $size $type"); + my $got = eval { + $rs->find($last_id)->$type + }; + diag $@ if $@; + ok($got eq $binstr{$size}, "verified inserted $size $type"); + } } - } - # try a blob update - TODO: { - local $TODO = 'updating TEXT/IMAGE does not work yet'; + # blob insert with explicit PK + { + local $SIG{__WARN__} = sub {}; + eval { $dbh->do('DROP TABLE bindtype_test') }; + + $dbh->do(qq[ + CREATE TABLE bindtype_test + ( + id INT PRIMARY KEY, + bytea INT NULL, + blob IMAGE NULL, + clob TEXT NULL + ) + ],{ RaiseError => 1, PrintError => 0 }); + } + 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"); - my $new_str = $binstr{large} . 'foo'; - eval { $rs->search({ id => $id })->update({ blob => $new_str }) }; + # try a blob update + my $new_str = $binstr{large} . 'mtfnpy'; + eval { $rs->search({ id => 1 })->update({ blob => $new_str }) }; ok !$@, 'updated blob successfully'; diag $@ if $@; - ok(eval { - $rs->search({ id=> $id }, { select => ['blob'] })->single->blob - } eq $new_str, "verified updated blob" ); + $got = eval { + $rs->find(1)->blob + }; diag $@ if $@; + ok($got eq $new_str, "verified updated blob"); } } @@ -179,6 +220,6 @@ SQL END { if (my $dbh = eval { $schema->storage->_dbh }) { $dbh->do('DROP TABLE artist'); - $dbh->do('DROP TABLE bindtype_test'); + eval { $dbh->do('DROP TABLE bindtype_test') }; } }