X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F750firebird.t;h=49443b24fa21dd49e79d172440a3eed3a515a658;hb=26148d36e66d7f7c67863cea8d6501739b765692;hp=44efe7c2e81d96d8f77343335f68434e7c0da6ce;hpb=dff4c3a37fb89cd0d4ba5d03859a86c1570851d1;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/750firebird.t b/t/750firebird.t
index 44efe7c..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 = (
@@ -22,42 +26,62 @@ my @info = (
   [ $dsn2, $user2, $pass2 ],
 );
 
-my @handles_to_clean;
+my $schema;
 
-foreach my $info (@info) {
-  my ($dsn, $user, $pass) = @$info;
+foreach my $conn_idx (0..$#info) {
+  my ($dsn, $user, $pass) = @{ $info[$conn_idx] || [] };
 
   next unless $dsn;
 
-  my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
-
+  $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
+    auto_savepoint  => 1,
+    quote_char      => q["],
+    name_sep        => q[.],
+    on_connect_call => 'use_softcommit',
+  });
   my $dbh = $schema->storage->dbh;
 
-  push @handles_to_clean, $dbh;
-
   my $sg = Scope::Guard->new(\&cleanup);
 
-  eval { $dbh->do("DROP TABLE artist") };
+  eval { $dbh->do(q[DROP TABLE "artist"]) };
   $dbh->do(<<EOF);
-  CREATE TABLE artist (
-    artistid INT PRIMARY KEY,
-    name VARCHAR(255),
-    charfield CHAR(10),
-    rank INT DEFAULT 13
+  CREATE TABLE "artist" (
+    "artistid" INT PRIMARY KEY,
+    "name" VARCHAR(255),
+    "charfield" CHAR(10),
+    "rank" INT DEFAULT 13
   )
 EOF
-  eval { $dbh->do("DROP GENERATOR gen_artist_artistid") };
-  $dbh->do('CREATE GENERATOR gen_artist_artistid');
-  eval { $dbh->do("DROP TRIGGER artist_bi") };
+  eval { $dbh->do(q[DROP GENERATOR "gen_artist_artistid"]) };
+  $dbh->do('CREATE GENERATOR "gen_artist_artistid"');
+  eval { $dbh->do('DROP TRIGGER "artist_bi"') };
   $dbh->do(<<EOF);
-  CREATE TRIGGER artist_bi FOR artist
+  CREATE TRIGGER "artist_bi" FOR "artist"
   ACTIVE BEFORE INSERT POSITION 0
   AS
   BEGIN
-   IF (NEW.artistid IS NULL) THEN
-    NEW.artistid = GEN_ID(gen_artist_artistid,1);
+   IF (NEW."artistid" IS NULL) THEN
+    NEW."artistid" = GEN_ID("gen_artist_artistid",1);
   END
 EOF
+  eval { $dbh->do('DROP TABLE "sequence_test"') };
+  $dbh->do(<<EOF);
+  CREATE TABLE "sequence_test" (
+    "pkid1" INT NOT NULL,
+    "pkid2" INT NOT NULL,
+    "nonpkid" INT,
+    "name" VARCHAR(255)
+  )
+EOF
+  $dbh->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' );
@@ -66,12 +90,49 @@ 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
+  throws_ok {
+    $schema->txn_do(sub {
+      eval {
+        $schema->txn_do(sub {
+          $ars->create({ name => 'in_savepoint' });
+          die "rolling back savepoint";
+        });
+      };
+      ok ((not $ars->search({ name => 'in_savepoint' })->first),
+        'savepoint rolled back');
+      $ars->create({ name => 'in_outer_txn' });
+      die "rolling back outer txn";
+    });
+  } qr/rolling back outer txn/,
+    'correct exception for rollback';
+
+  ok ((not $ars->search({ name => 'in_outer_txn' })->first),
+    'outer txn rolled back');
+
 # test explicit key spec
   $new = $ars->create ({ name => 'bar', artistid => 66 });
   is($new->artistid, 66, 'Explicit PK worked');
   $new->discard_changes;
   is($new->artistid, 66, 'Explicit PK assigned');
 
+# row update
+  lives_ok {
+    $new->update({ name => 'baz' })
+  } 'update survived';
+  $new->discard_changes;
+  is $new->name, 'baz', 'row updated';
+
 # test populate
   lives_ok (sub {
     my @pop;
@@ -93,6 +154,17 @@ EOF
 # count what we did so far
   is ($ars->count, 6, 'Simple count works');
 
+# test ResultSet UPDATE
+  lives_and {
+    $ars->search({ name => 'foo' })->update({ rank => 4 });
+
+    is eval { $ars->search({ name => 'foo' })->first->rank }, 4;
+  } 'Can update a column';
+
+  my ($updated) = $schema->resultset('Artist')->search({name => 'foo'});
+  is eval { $updated->rank }, 4, 'and the update made it to the database';
+
+
 # test LIMIT support
   my $lim = $ars->search( {},
     {
@@ -106,27 +178,47 @@ EOF
 
 # test iterator
   $lim->reset;
-  is( $lim->next->artistid, 101, "iterator->next ok" );
-  is( $lim->next->artistid, 102, "iterator->next ok" );
+  is( eval { $lim->next->artistid }, 101, "iterator->next ok" );
+  is( eval { $lim->next->artistid }, 102, "iterator->next ok" );
   is( $lim->next, undef, "next past end of resultset ok" );
 
+# test nested cursors
+  {
+    my $rs1 = $ars->search({}, { order_by => { -asc  => 'artistid' }});
+
+    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_test') };
+  eval { $dbh->do('DROP TABLE "bindtype_test"') };
   $dbh->do(q[
-  CREATE TABLE bindtype_test
+  CREATE TABLE "bindtype_test"
   (
-    id    INT   NOT NULL PRIMARY KEY,
-    bytea INT,
-    blob  BLOB,
-    clob  CLOB
+    "id"     INT PRIMARY KEY,
+    "bytea"  INT,
+    "blob"   BLOB,
+    "clob"   BLOB SUB_TYPE TEXT
   )
   ]);
 
@@ -149,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));
+        };
     }
   }
 }
@@ -159,14 +262,24 @@ done_testing;
 # clean up our mess
 
 sub cleanup {
-  foreach my $dbh (@handles_to_clean) {
-    eval { $dbh->do('DROP TRIGGER artist_bi') };
+  my $dbh;
+  eval {
+    $schema->storage->disconnect; # to avoid object FOO is in use errors
+    $dbh = $schema->storage->dbh;
+  };
+  return unless $dbh;
+
+  eval { $dbh->do('DROP TRIGGER "artist_bi"') };
+  diag $@ if $@;
+
+  foreach my $generator (qw/gen_artist_artistid pkid1_seq pkid2_seq
+                            nonpkid_seq/) {
+    eval { $dbh->do(qq{DROP GENERATOR "$generator"}) };
     diag $@ if $@;
-    eval { $dbh->do('DROP GENERATOR gen_artist_artistid') };
+  }
+
+  foreach my $table (qw/artist bindtype_test sequence_test/) {
+    eval { $dbh->do(qq[DROP TABLE "$table"]) };
     diag $@ if $@;
-    foreach my $table (qw/artist bindtype_test/) {
-      $dbh->do("DROP TABLE $table");
-      diag $@ if $@;
-    }
   }
 }