X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F746sybase.t;h=74587afef7f113f5a1d6252e929637720c7fc6f9;hb=d8cf3aa31fb3d6ff7813f021fcc002663725fc41;hp=5afbf3a8bb586cf9dfb2139297a4149e290d5f07;hpb=95787afeb4ecec13279ab2fb26a407c0f971b7df;p=dbsrgits%2FDBIx-Class.git diff --git a/t/746sybase.t b/t/746sybase.t index 5afbf3a..74587af 100644 --- a/t/746sybase.t +++ b/t/746sybase.t @@ -1,33 +1,25 @@ +BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } +use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_ase'; + use strict; -use warnings; +use warnings; no warnings 'uninitialized'; +use Config; use Test::More; use Test::Exception; -use lib qw(t/lib); -use DBICTest; - -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; - -my $TESTS = 63 + 2; +use DBIx::Class::_Util 'sigwarn_silencer'; -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; -} +use DBICTest; my @storage_types = ( 'DBI::Sybase::ASE', 'DBI::Sybase::ASE::NoBindVars', ); -eval "require $_" for @storage_types; my $schema; -my $storage_idx = -1; + +my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; sub get_schema { DBICTest::Schema->connect($dsn, $user, $pass, { @@ -39,6 +31,7 @@ sub get_schema { my $ping_count = 0; { + require DBIx::Class::Storage::DBI::Sybase::ASE; my $ping = DBIx::Class::Storage::DBI::Sybase::ASE->can('_ping'); *DBIx::Class::Storage::DBI::Sybase::ASE::_ping = sub { $ping_count++; @@ -47,7 +40,6 @@ my $ping_count = 0; } for my $storage_type (@storage_types) { - $storage_idx++; unless ($storage_type eq 'DBI::Sybase::ASE') { # autodetect DBICTest::Schema->storage_type("::$storage_type"); @@ -57,13 +49,12 @@ for my $storage_type (@storage_types) { $schema->storage->ensure_connected; - if ($storage_idx == 0 && - $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::ASE::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; - } + # we are going to explicitly test this anyway, just loop through + next if + $storage_type ne 'DBI::Sybase::ASE::NoBindVars' + and + $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars') + ; isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" ); @@ -90,6 +81,7 @@ SQL # test primary key handling my $new = $schema->resultset('Artist')->create({ name => 'foo' }); + like $new->artistid, qr/^\d+\z/, 'Auto-PK returned a number'; ok($new->artistid > 0, "Auto-PK worked"); $seen_id{$new->artistid}++; @@ -207,12 +199,16 @@ SQL name => { -like => 'bulk artist %' } }); -# test insert_bulk using populate. +# test _insert_bulk using populate. SKIP: { - skip 'insert_bulk not supported', 4 + skip '_insert_bulk not supported', 4 unless $storage_type !~ /NoBindVars/i; lives_ok { + + local $SIG{__WARN__} = sigwarn_silencer(qr/Sybase bulk API operation failed due to character set incompatibility/) + unless $ENV{DBICTEST_SYBASE_SUBTEST_RERUN}; + $schema->resultset('Artist')->populate([ { name => 'bulk artist 1', @@ -227,25 +223,25 @@ SQL charfield => 'foo', }, ]); - } 'insert_bulk via populate'; + } '_insert_bulk via populate'; - is $bulk_rs->count, 3, 'correct number inserted via insert_bulk'; + 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'); + 'column set correctly via _insert_bulk'); my %bulk_ids; @bulk_ids{map $_->artistid, $bulk_rs->all} = (); is ((scalar keys %bulk_ids), 3, - 'identities generated correctly in insert_bulk'); + 'identities generated correctly in _insert_bulk'); $bulk_rs->delete; } -# make sure insert_bulk works a second time on the same connection +# make sure _insert_bulk works a second time on the same connection SKIP: { - skip 'insert_bulk not supported', 3 + skip '_insert_bulk not supported', 3 unless $storage_type !~ /NoBindVars/i; lives_ok { @@ -263,36 +259,44 @@ SQL charfield => 'bar', }, ]); - } 'insert_bulk via populate called a second time'; + } '_insert_bulk via populate called a second time'; is $bulk_rs->count, 3, - 'correct number inserted via insert_bulk'; + 'correct number inserted via _insert_bulk'; is ((grep $_->charfield eq 'bar', $bulk_rs->all), 3, - 'column set correctly via insert_bulk'); + 'column set correctly via _insert_bulk'); $bulk_rs->delete; } -# test invalid insert_bulk (missing required column) +# test invalid _insert_bulk (missing required column) # -# There should be a rollback, reconnect and the next valid insert_bulk should -# succeed. throws_ok { + local $SIG{__WARN__} = sigwarn_silencer(qr/Sybase bulk API operation failed due to character set incompatibility/) + unless $ENV{DBICTEST_SYBASE_SUBTEST_RERUN}; + $schema->resultset('Artist')->populate([ { charfield => 'foo', } ]); - } qr/no value or default|does not allow null|placeholders/i, + } # The second pattern is the error from fallback to regular array insert on # incompatible charset. # The third is for ::NoBindVars with no syb_has_blk. - 'insert_bulk with missing required column throws error'; - -# now test insert_bulk with IDENTITY_INSERT + qr/ + \Qno value or default\E + | + \Qdoes not allow null\E + | + \QUnable to invoke fast-path insert without storage placeholder support\E + /xi, + '_insert_bulk with missing required column throws error'; + +# now test _insert_bulk with IDENTITY_INSERT SKIP: { - skip 'insert_bulk not supported', 3 + skip '_insert_bulk not supported', 3 unless $storage_type !~ /NoBindVars/i; lives_ok { @@ -313,13 +317,13 @@ SQL charfield => 'foo', }, ]); - } 'insert_bulk with IDENTITY_INSERT via populate'; + } '_insert_bulk with IDENTITY_INSERT via populate'; is $bulk_rs->count, 3, - 'correct number inserted via insert_bulk with IDENTITY_INSERT'; + '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'); + 'column set correctly via _insert_bulk with IDENTITY_INSERT'); $bulk_rs->delete; } @@ -336,7 +340,7 @@ SQL # mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t SKIP: { skip 'TEXT/IMAGE support does not work with FreeTDS', 22 - if $schema->storage->using_freetds; + if $schema->storage->_using_freetds; my $dbh = $schema->storage->_dbh; { @@ -344,12 +348,13 @@ SQL eval { $dbh->do('DROP TABLE bindtype_test') }; $dbh->do(qq[ - CREATE TABLE bindtype_test + CREATE TABLE bindtype_test ( - id INT IDENTITY PRIMARY KEY, - bytea IMAGE NULL, - blob IMAGE NULL, - clob TEXT NULL + id INT IDENTITY PRIMARY KEY, + bytea IMAGE NULL, + blob IMAGE NULL, + clob TEXT NULL, + a_memo IMAGE NULL ) ],{ RaiseError => 1, PrintError => 0 }); } @@ -358,8 +363,8 @@ SQL $binstr{'large'} = $binstr{'small'} x 1024; my $maxloblen = length $binstr{'large'}; - - if (not $schema->storage->using_freetds) { + + if (not $schema->storage->_using_freetds) { $dbh->{'LongReadLen'} = $maxloblen * 2; } else { $dbh->do("set textsize ".($maxloblen * 2)); @@ -433,33 +438,31 @@ SQL $rs->delete; - # now try insert_bulk with blobs and only blobs + # now try _insert_bulk with blobs and only blobs $new_str = $binstr{large} . 'bar'; lives_ok { $rs->populate([ { - bytea => 1, blob => $binstr{large}, clob => $new_str, }, { - bytea => 1, blob => $binstr{large}, clob => $new_str, }, ]); - } 'insert_bulk with blobs does not die'; + } '_insert_bulk with blobs does not die'; is((grep $_->blob eq $binstr{large}, $rs->all), 2, - 'IMAGE column set correctly via insert_bulk'); + 'IMAGE column set correctly via _insert_bulk'); is((grep $_->clob eq $new_str, $rs->all), 2, - 'TEXT column set correctly via insert_bulk'); + 'TEXT column set correctly via _insert_bulk'); - # now try insert_bulk with blobs and a non-blob which also happens to be an + # now try _insert_bulk with blobs and a non-blob which also happens to be an # identity column SKIP: { - skip 'no insert_bulk without placeholders', 4 + skip 'no _insert_bulk without placeholders', 4 if $storage_type =~ /NoBindVars/i; $rs->delete; @@ -471,24 +474,26 @@ SQL bytea => 1, blob => $binstr{large}, clob => $new_str, + a_memo => 2, }, { id => 2, bytea => 1, blob => $binstr{large}, clob => $new_str, + a_memo => 2, }, ]); - } 'insert_bulk with blobs and explicit identity does NOT die'; + } '_insert_bulk with blobs and explicit identity does NOT die'; is((grep $_->blob eq $binstr{large}, $rs->all), 2, - 'IMAGE column set correctly via insert_bulk with identity'); + 'IMAGE column set correctly via _insert_bulk with identity'); is((grep $_->clob eq $new_str, $rs->all), 2, - 'TEXT column set correctly via insert_bulk with identity'); + 'TEXT column set correctly via _insert_bulk with identity'); is_deeply [ map $_->id, $rs->all ], [ 1,2 ], - 'explicit identities set correctly via insert_bulk with blobs'; + 'explicit identities set correctly via _insert_bulk with blobs'; } lives_and { @@ -497,6 +502,13 @@ SQL $rs->update({ blob => undef }); is((grep !defined($_->blob), $rs->all), 2); } 'blob update to NULL'; + + lives_ok { + $schema->txn_do(sub { + my $created = $rs->create( { clob => "some text" } ); + }); + } 'insert blob field in transaction'; + $ping_count-- if $@; # failure retry triggers a ping } # test MONEY column support (and some other misc. stuff) @@ -532,7 +544,7 @@ SQL } # 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 @@ -556,33 +568,89 @@ SQL $row = $rs->create({ amount => 100 }); } 'inserted a money value'; - is eval { $rs->find($row->id)->amount }, 100, 'money value round-trip'; + cmp_ok 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'; + cmp_ok 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' + lives_and { + my $null_amount = $rs->find($row->id)->amount; + is $null_amount, undef; + } 'updated money value to NULL round-trip'; + +# Test computed columns and timestamps + $schema->storage->dbh_do (sub { + my ($storage, $dbh) = @_; + eval { $dbh->do("DROP TABLE computed_column_test") }; + $dbh->do(<<'SQL'); +CREATE TABLE computed_column_test ( + id INT IDENTITY PRIMARY KEY, + a_computed_column AS getdate(), + a_timestamp timestamp, + charfield VARCHAR(20) DEFAULT 'foo' +) +SQL + }); + + require DBICTest::Schema::ComputedColumn; + $schema->register_class( + ComputedColumn => 'DBICTest::Schema::ComputedColumn' ); - diag $@ if $@; + + ok (($rs = $schema->resultset('ComputedColumn')), + 'got rs for ComputedColumn'); + + lives_ok { $row = $rs->create({}) } + 'empty insert for a table with computed columns survived'; + + lives_ok { + $row->update({ charfield => 'bar' }) + } 'update of a table with computed columns survived'; } is $ping_count, 0, 'no pings'; +# if tests passed and did so under a non-C LC_ALL - let's rerun the test +if (Test::Builder->new->is_passing and $ENV{LC_ALL} and $ENV{LC_ALL} ne 'C') { + + pass ("Your LC_ALL is set to $ENV{LC_ALL} - retesting with C"); + + local $ENV{LC_ALL} = 'C'; + local $ENV{DBICTEST_SYBASE_SUBTEST_RERUN} = 1; + + local $ENV{PATH}; + local $ENV{PERL5LIB} = join ($Config{path_sep}, @INC); + my @cmd = map { $_ =~ /(.+)/ } ($^X, __FILE__); + + # this is cheating, and may even hang here and there (testing on windows passed fine) + # will be replaced with Test::SubExec::Noninteractive in due course + require IPC::Open2; + IPC::Open2::open2(my $out, undef, @cmd); + while (my $ln = <$out>) { + print " $ln"; + } + + wait; + ok (! $?, "Wstat $? from: @cmd"); +} + +done_testing; + # clean up our mess END { if (my $dbh = eval { $schema->storage->_dbh }) { eval { $dbh->do("DROP TABLE $_") } - for qw/artist bindtype_test money_test/; + for qw/artist bindtype_test money_test computed_column_test/; } + + undef $schema; }