X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F750firebird.t;h=49443b24fa21dd49e79d172440a3eed3a515a658;hb=1f870d5a08fa1794734380d7c8bd6753cdcf8f6d;hp=4a9d35e19d3e5d4773c551c4f5b9d91017e2ef4d;hpb=dd2109ee53a85847717c2ca2ff1c170b0b52bb9d;p=dbsrgits%2FDBIx-Class.git diff --git a/t/750firebird.t b/t/750firebird.t index 4a9d35e..49443b2 100644 --- a/t/750firebird.t +++ b/t/750firebird.t @@ -14,7 +14,11 @@ my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN U plan skip_all => <<'EOF' unless $dsn || $dsn2; Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN}, -_USER and _PASS to run these tests +_USER and _PASS to run these tests. + +WARNING: this test creates and drops the tables "artist", "bindtype_test" and +"sequence_test"; the generators "gen_artist_artistid", "pkid1_seq", "pkid2_seq" +and "nonpkid_seq" and the trigger "artist_bi". EOF my @info = ( @@ -60,6 +64,24 @@ EOF NEW."artistid" = GEN_ID("gen_artist_artistid",1); END EOF + eval { $dbh->do('DROP TABLE "sequence_test"') }; + $dbh->do(<do('ALTER TABLE "sequence_test" ADD CONSTRAINT "sequence_test_constraint" PRIMARY KEY ("pkid1", "pkid2")'); + eval { $dbh->do('DROP GENERATOR "pkid1_seq"') }; + eval { $dbh->do('DROP GENERATOR "pkid2_seq"') }; + eval { $dbh->do('DROP GENERATOR "nonpkid_seq"') }; + $dbh->do('CREATE GENERATOR "pkid1_seq"'); + $dbh->do('CREATE GENERATOR "pkid2_seq"'); + $dbh->do('SET GENERATOR "pkid2_seq" TO 9'); + $dbh->do('CREATE GENERATOR "nonpkid_seq"'); + $dbh->do('SET GENERATOR "nonpkid_seq" TO 19'); my $ars = $schema->resultset('Artist'); is ( $ars->count, 0, 'No rows at first' ); @@ -68,8 +90,18 @@ EOF my $new = $ars->create({ name => 'foo' }); ok($new->artistid, "Auto-PK worked"); +# test auto increment using generators WITHOUT triggers + for (1..5) { + my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); + is($st->pkid1, $_, "Firebird Auto-PK without trigger: First primary key"); + is($st->pkid2, $_ + 9, "Firebird Auto-PK without trigger: Second primary key"); + is($st->nonpkid, $_ + 19, "Firebird Auto-PK without trigger: Non-primary key"); + } + my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); + is($st->pkid1, 55, "Firebird Auto-PK without trigger: First primary key set manually"); + # test savepoints - eval { + throws_ok { $schema->txn_do(sub { eval { $schema->txn_do(sub { @@ -82,9 +114,7 @@ EOF $ars->create({ name => 'in_outer_txn' }); die "rolling back outer txn"; }); - }; - - like $@, qr/rolling back outer txn/, + } qr/rolling back outer txn/, 'correct exception for rollback'; ok ((not $ars->search({ name => 'in_outer_txn' })->first), @@ -96,6 +126,7 @@ EOF $new->discard_changes; is($new->artistid, 66, 'Explicit PK assigned'); +# row update lives_ok { $new->update({ name => 'baz' }) } 'update survived'; @@ -123,7 +154,7 @@ EOF # count what we did so far is ($ars->count, 6, 'Simple count works'); -# test UPDATE +# test ResultSet UPDATE lives_and { $ars->search({ name => 'foo' })->update({ rank => 4 }); @@ -151,57 +182,77 @@ EOF is( eval { $lim->next->artistid }, 102, "iterator->next ok" ); is( $lim->next, undef, "next past end of resultset ok" ); -# test multiple executing cursors +# test nested cursors { my $rs1 = $ars->search({}, { order_by => { -asc => 'artistid' }}); - my $rs2 = $ars->search({}, { order_by => { -desc => 'artistid' }}); - is $rs1->next->artistid, 1, 'multiple cursors'; - is $rs2->next->artistid, 102, 'multiple cursors'; + my $rs2 = $ars->search({ artistid => $rs1->next->artistid }, { + order_by => { -desc => 'artistid' } + }); + + is $rs2->next->artistid, 1, 'nested cursors'; } # test empty insert + lives_and { + my $row = $ars->create({}); + ok $row->artistid; + } 'empty insert works'; + +# test inferring the generator from the trigger source and using it with +# auto_nextval { - local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0; + local $ars->result_source->column_info('artistid')->{auto_nextval} = 1; - lives_ok { $ars->create({}) } - 'empty insert works'; + lives_and { + my $row = $ars->create({ name => 'introspecting generator' }); + ok $row->artistid; + } 'inferring generator from trigger source works'; } # test blobs (stolen from 73oracle.t) - SKIP: { - eval { $dbh->do('DROP TABLE "bindtype_test2"') }; - $dbh->do(q[ - CREATE TABLE "bindtype_test2" - ( - "id" INT PRIMARY KEY, - "bytea" INT, - "a_blob" BLOB, - "a_clob" BLOB SUB_TYPE TEXT - ) - ]); - - my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); - $binstr{'large'} = $binstr{'small'} x 1024; - - my $maxloblen = length $binstr{'large'}; - local $dbh->{'LongReadLen'} = $maxloblen; - - my $rs = $schema->resultset('BindType2'); - my $id = 0; - - foreach my $type (qw( a_blob a_clob )) { - foreach my $size (qw( small large )) { - $id++; + eval { $dbh->do('DROP TABLE "bindtype_test"') }; + $dbh->do(q[ + CREATE TABLE "bindtype_test" + ( + "id" INT PRIMARY KEY, + "bytea" INT, + "blob" BLOB, + "clob" BLOB SUB_TYPE TEXT + ) + ]); + + my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); + $binstr{'large'} = $binstr{'small'} x 1024; + + my $maxloblen = length $binstr{'large'}; + local $dbh->{'LongReadLen'} = $maxloblen; + + my $rs = $schema->resultset('BindType'); + my $id = 0; + + foreach my $type (qw( blob clob )) { + foreach my $size (qw( small large )) { + $id++; # turn off horrendous binary DBIC_TRACE output - local $schema->storage->{debug} = 0; + local $schema->storage->{debug} = 0; + + lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } + "inserted $size $type without dying"; + + my $got = $rs->find($id)->$type; - lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } - "inserted $size $type without dying"; + my $hexdump = sub { join '', map sprintf('%02X', ord), split //, shift }; - ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); - } + ok($got eq $binstr{$size}, "verified inserted $size $type" ) + or do { + diag "For " . (ref $schema->storage) . "\n"; + diag "Got blob:\n"; + diag $hexdump->(substr($got,0,50)); + diag "Expecting blob:\n"; + diag $hexdump->(substr($binstr{$size},0,50)); + }; } } } @@ -221,11 +272,14 @@ sub cleanup { eval { $dbh->do('DROP TRIGGER "artist_bi"') }; diag $@ if $@; - eval { $dbh->do('DROP GENERATOR "gen_artist_artistid"') }; - diag $@ if $@; + foreach my $generator (qw/gen_artist_artistid pkid1_seq pkid2_seq + nonpkid_seq/) { + eval { $dbh->do(qq{DROP GENERATOR "$generator"}) }; + diag $@ if $@; + } - foreach my $table (qw/artist bindtype_test/) { + foreach my $table (qw/artist bindtype_test sequence_test/) { eval { $dbh->do(qq[DROP TABLE "$table"]) }; - #diag $@ if $@; + diag $@ if $@; } }