X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F746sybase.t;h=9f52894f009ddbaa061b3bc17a79e0aa99f452ed;hb=7eee5c151525ef17674dac9b914acbd98f5f2f97;hp=8c0d3bf16a1bf8d5dfec651617b426c884311dc9;hpb=234193451aa53051d0c675f7236ab8fc55f8b6b0;p=dbsrgits%2FDBIx-Class.git diff --git a/t/746sybase.t b/t/746sybase.t index 8c0d3bf..9f52894 100644 --- a/t/746sybase.t +++ b/t/746sybase.t @@ -9,7 +9,7 @@ use DBICTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; -my $TESTS = 29 + 2; +my $TESTS = 35 + 2; if (not ($dsn && $user)) { plan skip_all => @@ -29,11 +29,13 @@ my $storage_idx = -1; for my $storage_type (@storage_types) { $storage_idx++; - $schema = DBICTest::Schema->clone; +# this is so we can set ->storage_type before connecting + my $schema = DBICTest::Schema->clone; unless ($storage_type eq 'DBI::Sybase') { # autodetect $schema->storage_type("::$storage_type"); } + $schema->connection($dsn, $user, $pass, { AutoCommit => 1, on_connect_call => [ @@ -42,11 +44,10 @@ 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 +# 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; @@ -54,6 +55,7 @@ for my $storage_type (@storage_types) { isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" ); + $schema->storage->_dbh->disconnect; lives_ok (sub { $schema->storage->dbh }, 'reconnect works'); $schema->storage->dbh_do (sub { @@ -74,6 +76,9 @@ SQL # so we start unconnected $schema->storage->disconnect; +# inserts happen in a txn, so we make sure it still works inside a txn too + $schema->txn_begin; + # test primary key handling my $new = $schema->resultset('Artist')->create({ name => 'foo' }); ok($new->artistid > 0, "Auto-PK worked"); @@ -86,6 +91,8 @@ SQL $seen_id{$new->artistid}++; } + $schema->txn_commit; + # test simple count is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok'); @@ -130,8 +137,8 @@ SQL # mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t SKIP: { - skip 'Need at least version 1.09 of DBD::Sybase to test TEXT/IMAGE', 12 - unless $DBD::Sybase::VERSION >= 1.09; + skip 'TEXT/IMAGE support does not work with FreeTDS', 12 + if $schema->storage->using_freetds; my $dbh = $schema->storage->dbh; { @@ -153,9 +160,12 @@ SQL $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; + + 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; @@ -178,21 +188,8 @@ SQL } } - # try a blob update - TODO: { - local $TODO = 'updating TEXT/IMAGE does not work yet'; - - my $new_str = $binstr{large} . 'foo'; - eval { $rs->search({ id => $last_id })->update({ blob => $new_str }) }; - ok !$@, 'updated blob successfully'; - diag $@ if $@; - ok(eval { - $rs->find($last_id)->blob - } eq $new_str, "verified updated blob" ); - diag $@ if $@; - } - # blob insert with explicit PK + # also a good opportunity to test IDENTITY_INSERT { local $SIG{__WARN__} = sub {}; eval { $dbh->do('DROP TABLE bindtype_test') }; @@ -200,7 +197,7 @@ SQL $dbh->do(qq[ CREATE TABLE bindtype_test ( - id INT PRIMARY KEY, + id INT IDENTITY PRIMARY KEY, bytea INT NULL, blob IMAGE NULL, clob TEXT NULL @@ -208,21 +205,71 @@ SQL ],{ RaiseError => 1, PrintError => 0 }); } my $created = eval { $rs->create( { id => 1, blob => $binstr{large} } ) }; - ok(!$@, "inserted large blob without dying"); + 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"); + ok($got eq $binstr{large}, "verified inserted large blob with manual PK"); + + # 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 $@; + $got = eval { + $rs->find(1)->blob + }; + diag $@ if $@; + ok($got eq $new_str, "verified updated blob"); } + +# 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 + }); + + 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 eval { $rs->find($row->id)->amount }, + 200, 'updated money value round-trip'; + + lives_ok { + $row->update({ amount => undef }); + } 'updated a money value to NULL'; + + my $null_amount = eval { $rs->find($row->id)->amount }; + ok( + (($null_amount == undef) && (not $@)), + 'updated money value to NULL round-trip' + ); + diag $@ if $@; } # clean up our mess END { if (my $dbh = eval { $schema->storage->_dbh }) { - $dbh->do('DROP TABLE artist'); - eval { $dbh->do('DROP TABLE bindtype_test') }; + eval { $dbh->do("DROP TABLE $_") } + for qw/artist bindtype_test money_test/; } }