[Bast-commits] r4902 - in DBIx-Class/0.08/trunk:
lib/DBIx/Class/InflateColumn t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Tue Oct 7 15:02:04 BST 2008
Author: ribasushi
Date: 2008-10-07 15:02:04 +0100 (Tue, 07 Oct 2008)
New Revision: 4902
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class/InflateColumn/File.pm
DBIx-Class/0.08/trunk/t/47bind_attribute.t
DBIx-Class/0.08/trunk/t/54taint.t
DBIx-Class/0.08/trunk/t/63register_class.t
DBIx-Class/0.08/trunk/t/72pg.t
DBIx-Class/0.08/trunk/t/81transactions.t
DBIx-Class/0.08/trunk/t/93storage_replication.t
DBIx-Class/0.08/trunk/t/98savepoints.t
DBIx-Class/0.08/trunk/t/bindtype_columns.t
Log:
Another round of warning-squashing:
Fix source registration/unregistration in several places
Accomodate postgres being really load on CREATE
Move the taint tests to a non-mainstream schema - hopefully this one will not be disturbed for a while
Fix warning due to File::Copy being sloppy
Test for TxnScopeGuard warnings
Test for multiple register_class warnings
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
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/InflateColumn/File.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/InflateColumn/File.pm 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/InflateColumn/File.pm 2008-10-07 14:02:04 UTC (rev 4902)
@@ -95,9 +95,11 @@
my $fs_file = $self->_file_column_file($column, $value->{filename});
mkpath [$fs_file->dir];
-
- File::Copy::copy($value->{handle}, $fs_file);
+ # File::Copy doesn't like Path::Class (or any for that matter) objects,
+ # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
+ File::Copy::copy($value->{handle}, $fs_file->stringify);
+
$self->_file_column_callback($value, $self, $column);
return $value->{filename};
Modified: DBIx-Class/0.08/trunk/t/47bind_attribute.t
===================================================================
--- DBIx-Class/0.08/trunk/t/47bind_attribute.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/47bind_attribute.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -73,6 +73,10 @@
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 }, {
Modified: DBIx-Class/0.08/trunk/t/54taint.t
===================================================================
--- DBIx-Class/0.08/trunk/t/54taint.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/54taint.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -13,11 +13,11 @@
: ( 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);
@@ -28,6 +28,6 @@
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;
Modified: DBIx-Class/0.08/trunk/t/63register_class.t
===================================================================
--- DBIx-Class/0.08/trunk/t/63register_class.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/63register_class.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -1,17 +1,25 @@
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');
Modified: DBIx-Class/0.08/trunk/t/72pg.t
===================================================================
--- DBIx-Class/0.08/trunk/t/72pg.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/72pg.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -47,13 +47,16 @@
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');
Modified: DBIx-Class/0.08/trunk/t/81transactions.t
===================================================================
--- DBIx-Class/0.08/trunk/t/81transactions.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/81transactions.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -8,7 +8,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 63;
+plan tests => 64;
my $code = sub {
my ($artist, @cd_titles) = @_;
@@ -235,7 +235,11 @@
$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;
@@ -268,12 +272,17 @@
ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
+ eval {
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
- eval {
- # The 0 arg says done die, just let the scope guard go out of scope
+ # 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");
Modified: DBIx-Class/0.08/trunk/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/trunk/t/93storage_replication.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/93storage_replication.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -59,8 +59,11 @@
## Get the Schema and set the replication storage type
sub init_schema {
+ # current SQLT SQLite producer does not handle DROP TABLE IF EXISTS, trap warnings here
+ local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /no such table.+DROP TABLE/ };
+
my $class = shift @_;
-
+
my $schema = DBICTest->init_schema(
sqlite_use_file => 1,
storage_type=>{
Modified: DBIx-Class/0.08/trunk/t/98savepoints.t
===================================================================
--- DBIx-Class/0.08/trunk/t/98savepoints.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/98savepoints.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -30,7 +30,11 @@
$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' });
Modified: DBIx-Class/0.08/trunk/t/bindtype_columns.t
===================================================================
--- DBIx-Class/0.08/trunk/t/bindtype_columns.t 2008-10-07 12:51:09 UTC (rev 4901)
+++ DBIx-Class/0.08/trunk/t/bindtype_columns.t 2008-10-07 14:02:04 UTC (rev 4902)
@@ -16,17 +16,19 @@
my $dbh = $schema->storage->dbh;
-$dbh->do(qq[
+{
+ 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 });
+}
- 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/
PK::Auto
More information about the Bast-commits
mailing list