Keep belongs_to related object / fk values in sync

[dbsrgits/DBIx-Class.git] / t / 750firebird.t

diff --git a/t/750firebird.t b/t/750firebird.t
index 27879a6..49443b2 100644 (file)
--- 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 = (
@@ -97,7 +101,7 @@ EOF
   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 {
@@ -110,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),
@@ -180,32 +182,43 @@ 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)
-  eval { $dbh->do('DROP TABLE "bindtype_test2"') };
+  eval { $dbh->do('DROP TABLE "bindtype_test"') };
   $dbh->do(q[
-  CREATE TABLE "bindtype_test2"
+  CREATE TABLE "bindtype_test"
   (
     "id"     INT PRIMARY KEY,
     "bytea"  INT,
-    "a_blob" BLOB,
-    "a_clob" BLOB SUB_TYPE TEXT
+    "blob"   BLOB,
+    "clob"   BLOB SUB_TYPE TEXT
   )
   ]);
 
@@ -215,10 +228,10 @@ EOF
   my $maxloblen = length $binstr{'large'};
   local $dbh->{'LongReadLen'} = $maxloblen;
 
-  my $rs = $schema->resultset('BindType2');
+  my $rs = $schema->resultset('BindType');
   my $id = 0;
 
-  foreach my $type (qw( a_blob a_clob )) {
+  foreach my $type (qw( blob clob )) {
     foreach my $size (qw( small large )) {
       $id++;
 
@@ -228,7 +241,18 @@ EOF
       lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
       "inserted $size $type without dying";
 
-      ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
+      my $got = $rs->find($id)->$type;
+
+      my $hexdump = sub { join '', map sprintf('%02X', ord), split //, shift };
+
+      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));
+        };
     }
   }
 }
@@ -254,7 +278,7 @@ sub cleanup {
     diag $@ if $@;
   }
 
-  foreach my $table (qw/artist bindtype_test2 sequence_test/) {
+  foreach my $table (qw/artist bindtype_test sequence_test/) {
     eval { $dbh->do(qq[DROP TABLE "$table"]) };
     diag $@ if $@;
   }