Blindly silence a weird warning within a TODO in t/47bind_attribute.t. Hopefully when the TODO is resolved, it will be obvious what was causing it
Merge the t/93single_accessor_object.t fix from trunk
my $fs_file = $self->_file_column_file($column, $value->{filename});
mkpath [$fs_file->dir];
- File::Copy::copy($value->{handle}, $fs_file);
+ File::Copy::copy($value->{handle}, $fs_file->stringify); # File::Copy doesn't like Path::Class (or any for that matter) objects
$self->_file_column_callback($value, $self, $column);
$self->_do_connection_actions($connection_do) if ref($connection_do);
$self->_dbh->rollback unless $self->_dbh_autocommit;
- $self->_dbh->disconnect;
+
+ # SQLite is evil/brainded and must be DESTROYed without disconnecting: http://www.perlmonks.org/?node_id=666210
+ $self->_dbh->disconnect if $self->_dbh->get_info(17) ne 'SQLite';
+
$self->_dbh(undef);
$self->{_dbh_gen}++;
}
use lib qw(t/lib);
use DBICTest;
-plan tests => 5;
+plan tests => 6;
my $db_orig = "$FindBin::Bin/var/DBIxClass.db";
my $db_tmp = "$db_orig.tmp";
cmp_ok(@art, '==', 3, "Three artists returned");
# Disconnect the dbh, and be sneaky about it
-$schema->storage->_dbh->disconnect;
+# Also test if DBD::SQLite finaly knows how to ->disconnect properly
+TODO: {
+ local $TODO = 'SQLite is evil/braindead. Once this test starts passing, remove the related atrocity from DBIx::Class::Storage::DBI::disconnect()';
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ $schema->storage->_dbh->disconnect;
+ ok ($w !~ /active statement handles/, 'SQLite can disconnect properly \o/');
+}
# Try the operation again - What should happen here is:
# 1. S::DBI blindly attempts the SELECT, which throws an exception
chmod 0000, $db_orig;
### Try the operation again... it should fail, since there's no db
-eval {
- my @art_three = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
-};
-ok( $@, 'The operation failed' );
+{
+ # Catch the DBI connection error (disabling PrintError entirely is unwise)
+ local $SIG{__WARN__} = sub {};
+ eval {
+ my @art_three = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
+ };
+ ok( $@, 'The operation failed' );
+}
### Now, move the db file back to the correct name
unlink($db_orig);
is ( $rs->count, 1, '...cookbook (bind first) + chained search' );
TODO: {
+ # not sure what causes an uninit warning here, please remove when the TODO starts to pass,
+ # so the real reason for the warning can be found and fixed
+ local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /uninitialized/ };
+
local $TODO = 'bind args order needs fixing (semifor)';
$rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] })
->search({ 'artistid' => 1 }, {
: ( tests => 2 );
}
-package DBICTest::Schema;
+package DBICTest::Plain;
-# Use the default test class namespace to avoid the need for a
+# Use the Plain test class namespace to avoid the need for a
# new test infrastructure. If invalid classes will be introduced to
-# 't/lib/DBICTest/Schema/' someday, this has to be reworked.
+# 't/lib/DBICTest/Plain/' someday, this has to be reworked.
use lib qw(t/lib);
eval{ __PACKAGE__->load_classes() };
cmp_ok( $@, 'eq', '',
'Loading classes with Module::Find worked in taint mode' );
-ok( __PACKAGE__->sources(), 'At least on source has been registered' );
+ok( __PACKAGE__->source('Test'), 'The Plain::Test source has been registered' );
1;
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 3;
use lib qw(t/lib);
use DBICTest;
use DBICTest::Schema;
use DBICTest::Schema::Artist;
DBICTest::Schema::Artist->source_name('MyArtist');
-DBICTest::Schema->register_class('FooA', 'DBICTest::Schema::Artist');
+{
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ DBICTest::Schema->register_class('FooA', 'DBICTest::Schema::Artist');
+ like ($w, qr/use register_extra_source/, 'Complain about using register_class on an already-registered class');
+}
my $schema = DBICTest->init_schema();
my $a = $schema->resultset('FooA')->search;
is($a->count, 3, 'have 3 artists');
is($schema->class('FooA'), 'DBICTest::FooA', 'Correct artist class');
+
+# clean up
+DBICTest::Schema->_unregister_source('FooA');
my $dbh = $schema->storage->dbh;
$schema->source("Artist")->name("testschema.artist");
$schema->source("SequenceTest")->name("testschema.sequence_test");
-$dbh->do("CREATE SCHEMA testschema;");
-$dbh->do("CREATE TABLE testschema.artist (artistid serial PRIMARY KEY, name VARCHAR(100), charfield CHAR(10));");
-$dbh->do("CREATE TABLE testschema.sequence_test (pkid1 integer, pkid2 integer, nonpkid integer, name VARCHAR(100), CONSTRAINT pk PRIMARY KEY(pkid1, pkid2));");
-$dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
-$dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
-$dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
-ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3));'), 'Creation of casecheck table');
+{
+ local $SIG{__WARN__} = sub {};
+ $dbh->do("CREATE SCHEMA testschema;");
+ $dbh->do("CREATE TABLE testschema.artist (artistid serial PRIMARY KEY, name VARCHAR(100), charfield CHAR(10));");
+ $dbh->do("CREATE TABLE testschema.sequence_test (pkid1 integer, pkid2 integer, nonpkid integer, name VARCHAR(100), CONSTRAINT pk PRIMARY KEY(pkid1, pkid2));");
+ $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
+ $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
+ $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
+ ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3));'), 'Creation of casecheck table');
+}
# This is in Core now, but it's here just to test that it doesn't break
$schema->class('Artist')->load_components('PK::Auto');
my $schema = DBICTest->init_schema();
-plan tests => 63;
+plan tests => 64;
my $code = sub {
my ($artist, @cd_titles) = @_;
$schema2->txn_begin();
};
my $err = $@;
- ok(($err eq ''), 'Pre-connection nested transactions.');
+ ok(! $err, 'Pre-connection nested transactions.');
+
+ # although not connected DBI would still warn about rolling back at disconnect
+ $schema2->txn_rollback;
+ $schema2->txn_rollback;
$schema2->storage->disconnect;
}
$schema->storage->disconnect;
ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
-
eval {
- # The 0 arg says done die, just let the scope guard go out of scope
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+
+ # The 0 arg says don't die, just let the scope guard go out of scope
# forcing a txn_rollback to happen
outer($schema, 0);
+
+ like ($w, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or an error/, 'Out of scope warning detected');
};
+
local $TODO = "Work out how this should work";
is($@, "Not sure what we want here, but something", "Rollback okay");
my $tvrs = $schema_orig->{vschema}->resultset('Table');
is($schema_orig->_source_exists($tvrs), 1, 'Created schema from DDL file');
+# loading a new module defining a new version of the same table
+DBICVersion::Schema->_unregister_source ('Table');
eval "use DBICVersionNew";
+
{
unlink('t/var/DBICVersion-Schema-2.0-MySQL.sql');
unlink('t/var/DBICVersion-Schema-1.0-2.0-MySQL.sql');
is($schema_upgrade->schema_version, '2.0', 'schema version ok');
$schema_upgrade->create_ddl_dir('MySQL', '2.0', 't/var', '1.0');
ok(-f 't/var/DBICVersion-Schema-1.0-2.0-MySQL.sql', 'Created DDL file');
+
$schema_upgrade->upgrade();
is($schema_upgrade->get_db_version(), '2.0', 'db version number upgraded');
$schema->storage->debug(1);
-$schema->storage->dbh->do ($create_sql);
+{
+ local $SIG{__WARN__} = sub {};
+ $schema->storage->dbh->do ('DROP TABLE IF EXISTS artist');
+ $schema->storage->dbh->do ($create_sql);
+}
$schema->resultset('Artist')->create({ name => 'foo' });
my $dbh = $schema->storage->dbh;
-$dbh->do(qq[
-
- CREATE TABLE artist
- (
- artistid serial NOT NULL PRIMARY KEY,
- media bytea NOT NULL,
- name varchar NULL
- );
-],{ RaiseError => 1, PrintError => 1 });
-
+{
+ local $SIG{__WARN__} = sub {};
+ $dbh->do('DROP TABLE IF EXISTS artist');
+ $dbh->do(qq[
+ CREATE TABLE artist
+ (
+ artistid serial NOT NULL PRIMARY KEY,
+ media bytea NOT NULL,
+ name varchar NULL
+ );
+ ],{ RaiseError => 1, PrintError => 1 });
+}
$schema->class('Artist')->load_components(qw/
projects / dbsrgits/DBIx-Class.git / commitdiff