Merge 'trunk' into 'current'
Dagfinn Ilmari Mannsåker [Tue, 5 Feb 2008 18:10:00 +0000 (18:10 +0000)]
r25769@vesla (orig r3882):  ilmari | 2007-11-15 14:14:15 +0000
Version bump for release.

r27943@vesla (orig r3899):  ilmari | 2007-12-14 04:58:03 +0000
Fix test skip count for main skip_rels block
r28481@vesla (orig r3976):  ilmari | 2008-01-27 05:05:04 +0000
Add support for load_namespaces-style class layout.
r28496@vesla (orig r3991):  ilmari | 2008-01-30 14:25:32 +0000
Mention _extra_column_info in DBIC::S::L::DBI::Writing

r28522@vesla (orig r4017):  ilmari | 2008-02-02 21:27:07 +0000
Fix auto-inc column cration for the Oracle tests
r28523@vesla (orig r4018):  ilmari | 2008-02-02 21:38:45 +0000
Fix some typos

r28524@vesla (orig r4019):  ilmari | 2008-02-02 21:43:53 +0000
Clean up Oracle loader code

r28540@vesla (orig r4035):  ilmari | 2008-02-05 16:32:20 +0000
Make sure to get the constraint columns in the right order.

16 files changed:
Changes
lib/DBIx/Class/Schema/Loader.pm
lib/DBIx/Class/Schema/Loader/Base.pm
lib/DBIx/Class/Schema/Loader/DBI.pm
lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
lib/DBIx/Class/Schema/Loader/DBI/Writing.pm
lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
lib/DBIx/Class/Schema/Loader/RelBuilder.pm
t/10sqlite_common.t
t/11mysql_common.t
t/13db2_common.t
t/14ora_common.t
t/lib/dbixcsl_common_tests.pm

diff --git a/Changes b/Changes
index 88a594a..e2cbf07 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,11 +1,19 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
-Not yet released
+0.04999_01 Not yet released
+        - Mark foreign key columns with is_foreign_key => 1
+        - Add support for vendor-specific extra column attributes.
+        - Add support for extra => { unsigned => 1 } for MySQL.
+        - Add support for enum value lists for MySQL
+        - Set join_type => 'LEFT OUTER' for nullable foreign keys
+          (patch from Bernhard Weißhuhn)
+        - Set is_auto_increment for auto-increment columns (RT #31473)
+          (Only SQLite, MySQL and PostgreSQL are currently supported)
+        - Generate one-to-one accessors for unique foreign keys (ilmari)
         - Add support for load_namespaces-style class layout
         - Fix test skip count for main skip_rels block
         - Fix auto-inc column creation for the Oracle tests
-
-0.04004 Thu Nov 15, 2007
+        - Fix column ordering in unique constraints for Oracle
         - Fix Win32 test skip counts for good (RT #30568, Kenichi Ishigaki)
         - Default Oracle db_schema to db username (patch
           from Johannes Plunien)
index 5147aa6..1c59211 100644 (file)
@@ -11,7 +11,7 @@ use Scalar::Util qw/ weaken /;
 # Always remember to do all digits for the version even if they're 0
 # i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
 # brain damage and presumably various other packaging systems too
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 __PACKAGE__->mk_classaccessor('_loader_args' => {});
 __PACKAGE__->mk_classaccessors(qw/dump_to_dir _loader_invoked _loader/);
index aa6e381..4b2c343 100644 (file)
@@ -14,7 +14,7 @@ use Cwd qw//;
 use Digest::MD5 qw//;
 require DBIx::Class;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 __PACKAGE__->mk_ro_accessors(qw/
                                 schema
@@ -652,6 +652,12 @@ sub _setup_src_meta {
     }
     else {
         my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
+        my $fks = $self->_table_fk_info($table);
+        for my $fkdef (@$fks) {
+            for my $col (@{ $fkdef->{local_columns} }) {
+                $col_info_lc{$col}->{is_foreign_key} = 1;
+            }
+        }
         $self->_dbic_stmt(
             $table_class,
             'add_columns',
@@ -709,9 +715,10 @@ sub _load_relationships {
         $fkdef->{remote_source} =
             $self->monikers->{delete $fkdef->{remote_table}};
     }
+    my $tbl_uniq_info = $self->_table_uniq_info($table);
 
     my $local_moniker = $self->monikers->{$table};
-    my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info);
+    my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
 
     foreach my $src_class (sort keys %$rel_stmts) {
         my $src_stmts = $rel_stmts->{$src_class};
index 10c51fc..f27d882 100644 (file)
@@ -7,7 +7,7 @@ use Class::C3;
 use Carp::Clan qw/^DBIx::Class/;
 use UNIVERSAL::require;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 =head1 NAME
 
@@ -222,7 +222,9 @@ sub _columns_info_for {
                 my $col_name = $info->{COLUMN_NAME};
                 $col_name =~ s/^\"(.*)\"$/$1/;
 
-                $result{$col_name} = \%column_info;
+                my $extra_info = $self->_extra_column_info($info) || {};
+
+                $result{$col_name} = { %column_info, %$extra_info };
             }
             $sth->finish;
         };
@@ -247,7 +249,9 @@ sub _columns_info_for {
             $column_info{size}    = $2;
         }
 
-        $result{$columns[$i]} = \%column_info;
+        my $extra_info = $self->_extra_column_info($table, $columns[$i], $sth, $i) || {};
+
+        $result{$columns[$i]} = { %column_info, %$extra_info };
     }
     $sth->finish;
 
@@ -265,6 +269,10 @@ sub _columns_info_for {
     return \%result;
 }
 
+# Override this in vendor class to return any additional column
+# attributes
+sub _extra_column_info {}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>
index 800a2bb..bf2038f 100644 (file)
@@ -6,7 +6,7 @@ use base 'DBIx::Class::Schema::Loader::DBI';
 use Carp::Clan qw/^DBIx::Class/;
 use Class::C3;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 =head1 NAME
 
index 3be38e2..c819c9d 100644 (file)
@@ -8,7 +8,7 @@ use base 'DBIx::Class::Schema::Loader::DBI';
 use Carp::Clan qw/^DBIx::Class/;
 use Class::C3;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 =head1 NAME
 
index b04e0fb..c962e0b 100644 (file)
@@ -6,7 +6,7 @@ use base 'DBIx::Class::Schema::Loader::DBI';
 use Carp::Clan qw/^DBIx::Class/;
 use Class::C3;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 =head1 NAME
 
@@ -95,6 +95,17 @@ sub _table_uniq_info {
     return \@uniqs;
 }
 
+sub _extra_column_info {
+    my ($self, $info) = @_;
+    my %extra_info;
+
+    if ($info->{COLUMN_DEF} && $info->{COLUMN_DEF} =~ /\bnextval\(/i) {
+        $extra_info{is_auto_increment} = 1;
+    }
+
+    return \%extra_info;
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
index 23db551..4f21f86 100644 (file)
@@ -7,7 +7,7 @@ use Carp::Clan qw/^DBIx::Class/;
 use Text::Balanced qw( extract_bracketed );
 use Class::C3;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 =head1 NAME
 
@@ -52,6 +52,7 @@ sub _sqlite_parse_table {
 
     my @rels;
     my @uniqs;
+    my %auto_inc;
 
     my $dbh = $self->schema->storage->dbh;
     my $sth = $self->{_cache}->{sqlite_master}
@@ -110,6 +111,11 @@ sub _sqlite_parse_table {
             push(@uniqs, [ $name => \@cols ]);
         }
 
+        if ($col =~ /AUTOINCREMENT/i) {
+            $col =~ /^(\S+)/;
+            $auto_inc{lc $1} = 1;
+        }
+
         next if $col !~ /^(.*\S)\s+REFERENCES\s+(\w+) (?: \s* \( (.*) \) )? /ix;
 
         my ($cols, $f_table, $f_cols) = ($1, $2, $3);
@@ -137,7 +143,21 @@ sub _sqlite_parse_table {
         });
     }
 
-    return { rels => \@rels, uniqs => \@uniqs };
+    return { rels => \@rels, uniqs => \@uniqs, auto_inc => \%auto_inc };
+}
+
+sub _extra_column_info {
+    my ($self, $table, $col_name, $sth, $col_num) = @_;
+    my %extra_info;
+
+    $self->{_sqlite_parse_data}->{$table} ||=
+        $self->_sqlite_parse_table($table);
+
+    if ($self->{_sqlite_parse_data}->{$table}->{auto_inc}->{$col_name}) {
+        $extra_info{is_auto_increment} = 1;
+    }
+
+    return \%extra_info;
 }
 
 sub _table_fk_info {
index 7bbb9d2..867b045 100644 (file)
@@ -1,7 +1,7 @@
 package DBIx::Class::Schema::Loader::DBI::Writing;
 use strict;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 # Empty. POD only.
 
index 34cca83..f488ba2 100644 (file)
@@ -6,7 +6,7 @@ use base 'DBIx::Class::Schema::Loader::DBI';
 use Carp::Clan qw/^DBIx::Class/;
 use Class::C3;
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 =head1 NAME
 
@@ -121,6 +121,23 @@ sub _table_uniq_info {
     return \@uniqs;
 }
 
+sub _extra_column_info {
+    my ($self, $info) = @_;
+    my %extra_info;
+
+    if ($info->{mysql_is_auto_increment}) {
+        $extra_info{is_auto_increment} = 1
+    }
+    if ($info->{mysql_type_name} =~ /\bunsigned\b/i) {
+        $extra_info{extra}{unsigned} = 1;
+    }
+    if ($info->{mysql_values}) {
+        $extra_info{extra}{list} = $info->{mysql_values};
+    }
+
+    return \%extra_info;
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
index 6c23177..73fc33c 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use Carp::Clan qw/^DBIx::Class/;
 use Lingua::EN::Inflect::Number ();
 
-our $VERSION = '0.04004';
+our $VERSION = '0.04999_01';
 
 =head1 NAME
 
@@ -121,8 +121,19 @@ sub _inflect_singular {
     return Lingua::EN::Inflect::Number::to_S($relname);
 }
 
+sub _array_eq {
+    my ($a, $b) = @_;
+
+    return unless @$a == @$b;
+
+    for (my $i = 0; $i < @$a; $i++) {
+        return unless $a->[$i] eq $b->[$i];
+    }
+    return 1;
+}
+
 sub generate_code {
-    my ($self, $local_moniker, $rels) = @_;
+    my ($self, $local_moniker, $rels, $uniqs) = @_;
 
     my $all_code = {};
 
@@ -187,17 +198,32 @@ sub generate_code {
             delete $rev_cond{$_};
         }
 
+        my $remote_method = 'has_many';
+
+        # If the local columns have a UNIQUE constraint, this is a one-to-one rel
+        my $local_source = $self->{schema}->source($local_moniker);
+        if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
+            grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
+            $remote_method = 'might_have';
+            $local_relname = $self->_inflect_singular($local_relname);
+        }
+
+        # If the referring column is nullable, make 'belongs_to' an outer join:
+        my $nullable = grep { $local_source->column_info($_)->{is_nullable} }
+          @$local_cols;
+
         push(@{$all_code->{$local_class}},
             { method => 'belongs_to',
               args => [ $remote_relname,
                         $remote_class,
                         \%cond,
+                        $nullable ? { join_type => 'LEFT OUTER' } : ()
               ],
             }
         );
 
         push(@{$all_code->{$remote_class}},
-            { method => 'has_many',
+            { method => $remote_method,
               args => [ $local_relname,
                         $local_class,
                         \%rev_cond,
index 7899cf6..13bb045 100644 (file)
@@ -8,7 +8,7 @@ my $class = $@ ? 'SQLite2' : 'SQLite';
 {
     my $tester = dbixcsl_common_tests->new(
         vendor          => 'SQLite',
-        auto_inc_pk     => 'INTEGER NOT NULL PRIMARY KEY',
+        auto_inc_pk     => 'INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT',
         dsn             => "dbi:$class:dbname=./t/sqlite_test",
         user            => '',
         password        => '',
index c65c7b1..bd86d93 100644 (file)
@@ -1,6 +1,7 @@
 use strict;
 use lib qw(t/lib);
 use dbixcsl_common_tests;
+use Test::More;
 
 my $dsn         = $ENV{DBICTEST_MYSQL_DSN} || '';
 my $user        = $ENV{DBICTEST_MYSQL_USER} || '';
@@ -19,6 +20,32 @@ my $tester = dbixcsl_common_tests->new(
     skip_rels        => $test_innodb ? 0 : $skip_rels_msg,
     no_inline_rels   => 1,
     no_implicit_rels => 1,
+    extra            => {
+        create => [
+            qq{
+                CREATE TABLE mysql_loader_test1 (
+                    id INTEGER UNSIGNED NOT NULL PRIMARY KEY,
+                    value ENUM('foo', 'bar', 'baz')
+                )
+            },
+        ],
+        drop   => [ qw/ mysql_loader_test1 / ],
+        count  => 3,
+        run    => sub {
+            my ($schema, $monikers, $classes) = @_;
+        
+            my $rs = $schema->resultset($monikers->{mysql_loader_test1});
+            my $column_info = $rs->result_source->column_info('id');
+            
+            is($column_info->{extra}->{unsigned}, 1, 'Unsigned MySQL columns');
+
+            $column_info = $rs->result_source->column_info('value');
+
+            like($column_info->{data_type}, qr/^enum$/i, 'MySQL ENUM type');
+            is_deeply($column_info->{extra}->{list}, [qw/foo bar baz/],
+                      'MySQL ENUM values');
+        },
+    }
 );
 
 if( !$dsn || !$user ) {
index b52fa68..e616f21 100644 (file)
@@ -13,6 +13,7 @@ my $tester = dbixcsl_common_tests->new(
     user           => $user,
     password       => $password,
     db_schema      => uc $user,
+    no_auto_increment => 1
 );
 
 if( !$dsn || !$user ) {
index 2cd05b5..e88f8e1 100644 (file)
@@ -30,6 +30,7 @@ my $tester = dbixcsl_common_tests->new(
     dsn         => $dsn,
     user        => $user,
     password    => $password,
+    no_auto_increment => 1,
 );
 
 if( !$dsn || !$user ) {
index 75d6090..8e2d969 100644 (file)
@@ -25,6 +25,9 @@ sub new {
     
     $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
 
+    # Optional extra tables and tests
+    $self->{extra} ||= {};
+
     return bless $self => $class;
 }
 
@@ -43,7 +46,7 @@ sub _monikerize {
 sub run_tests {
     my $self = shift;
 
-    plan tests => 88;
+    plan tests => 136 + ($self->{extra}->{count} || 0);
 
     $self->create();
 
@@ -53,7 +56,7 @@ sub run_tests {
 
     my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} );
     my %loader_opts = (
-        constraint              => qr/^(?:\S+\.)?loader_test[0-9]+$/i,
+        constraint              => qr/^(?:\S+\.)?(?:$self->{vendor}_)?loader_test[0-9]+$/i,
         relationships           => 1,
         additional_classes      => 'TestAdditional',
         additional_base_classes => 'TestAdditionalBase',
@@ -223,6 +226,14 @@ sub run_tests {
         #}
     }
 
+    SKIP: {
+        skip "This vendor doesn't detect auto-increment columns", 1
+            if $self->{no_auto_increment};
+
+        is( $class1->column_info('id')->{is_auto_increment}, 1,
+            'Setting is_auto_incrment works'
+        );
+    }
 
     my $obj    = $rsobj1->find(1);
     is( $obj->id,  1 );
@@ -244,7 +255,7 @@ sub run_tests {
     is( $obj2->id, 2 );
 
     SKIP: {
-        skip $self->{skip_rels}, 50 if $self->{skip_rels};
+        skip $self->{skip_rels}, 69 if $self->{skip_rels};
 
         my $moniker3 = $monikers->{loader_test3};
         my $class3   = $classes->{loader_test3};
@@ -310,6 +321,34 @@ sub run_tests {
         my $class26   = $classes->{loader_test26};
         my $rsobj26   = $conn->resultset($moniker26);
 
+        my $moniker27 = $monikers->{loader_test27};
+        my $class27   = $classes->{loader_test27};
+        my $rsobj27   = $conn->resultset($moniker27);
+
+        my $moniker28 = $monikers->{loader_test28};
+        my $class28   = $classes->{loader_test28};
+        my $rsobj28   = $conn->resultset($moniker28);
+
+        my $moniker29 = $monikers->{loader_test29};
+        my $class29   = $classes->{loader_test29};
+        my $rsobj29   = $conn->resultset($moniker29);
+
+        my $moniker31 = $monikers->{loader_test31};
+        my $class31   = $classes->{loader_test31};
+        my $rsobj31   = $conn->resultset($moniker31);
+
+        my $moniker32 = $monikers->{loader_test32};
+        my $class32   = $classes->{loader_test32};
+        my $rsobj32   = $conn->resultset($moniker32);
+
+        my $moniker33 = $monikers->{loader_test33};
+        my $class33   = $classes->{loader_test33};
+        my $rsobj33   = $conn->resultset($moniker33);
+
+        my $moniker34 = $monikers->{loader_test34};
+        my $class34   = $classes->{loader_test34};
+        my $rsobj34   = $conn->resultset($moniker34);
+
         isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
@@ -326,11 +365,20 @@ sub run_tests {
         isa_ok( $rsobj22, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj25, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj26, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj27, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj28, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj29, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj31, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj32, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj33, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj34, "DBIx::Class::ResultSet" );
 
         # basic rel test
         my $obj4 = $rsobj4->find(123);
         isa_ok( $obj4->fkid_singular, $class3);
 
+        ok($class4->column_info('fkid')->{is_foreign_key});
+
         my $obj3 = $rsobj3->find(1);
         my $rs_rel4 = $obj3->search_related('loader_test4zes');
         isa_ok( $rs_rel4->first, $class4);
@@ -344,10 +392,16 @@ sub run_tests {
         isa_ok( $obj6->loader_test2, $class2);
         isa_ok( $obj6->loader_test5, $class5);
 
+        ok($class6->column_info('loader_test2')->{is_foreign_key});
+        ok($class6->column_info('id')->{is_foreign_key});
+        ok($class6->column_info('id2')->{is_foreign_key});
+
         # fk that references a non-pk key (UNIQUE)
         my $obj8 = $rsobj8->find(1);
         isa_ok( $obj8->loader_test7, $class7);
 
+        ok($class8->column_info('loader_test7')->{is_foreign_key});
+
         # test double-fk 17 ->-> 16
         my $obj17 = $rsobj17->find(33);
 
@@ -355,18 +409,26 @@ sub run_tests {
         isa_ok($rs_rel16_one, $class16);
         is($rs_rel16_one->dat, 'y16');
 
+        ok($class17->column_info('loader16_one')->{is_foreign_key});
+
         my $rs_rel16_two = $obj17->loader16_two;
         isa_ok($rs_rel16_two, $class16);
         is($rs_rel16_two->dat, 'z16');
 
+        ok($class17->column_info('loader16_two')->{is_foreign_key});
+
         my $obj16 = $rsobj16->find(2);
         my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones');
         isa_ok($rs_rel17->first, $class17);
         is($rs_rel17->first->id, 3);
         
         # XXX test m:m 18 <- 20 -> 19
+        ok($class20->column_info('parent')->{is_foreign_key});
+        ok($class20->column_info('child')->{is_foreign_key});
         
         # XXX test double-fk m:m 21 <- 22 -> 21
+        ok($class22->column_info('parent')->{is_foreign_key});
+        ok($class22->column_info('child')->{is_foreign_key});
 
         # test double multi-col fk 26 -> 25
         my $obj26 = $rsobj26->find(33);
@@ -375,6 +437,10 @@ sub run_tests {
         isa_ok($rs_rel25_one, $class25);
         is($rs_rel25_one->dat, 'x25');
 
+        ok($class26->column_info('id')->{is_foreign_key});
+        ok($class26->column_info('rel1')->{is_foreign_key});
+        ok($class26->column_info('rel2')->{is_foreign_key});
+
         my $rs_rel25_two = $obj26->loader_test25_id_rel2;
         isa_ok($rs_rel25_two, $class25);
         is($rs_rel25_two->dat, 'y25');
@@ -384,10 +450,64 @@ sub run_tests {
         isa_ok($rs_rel26->first, $class26);
         is($rs_rel26->first->id, 3);
 
+        # test one-to-one rels
+        my $obj27 = $rsobj27->find(1);
+        my $obj28 = $obj27->loader_test28;
+        isa_ok($obj28, $class28);
+        is($obj28->get_column('id'), 1);
+
+        ok($class28->column_info('id')->{is_foreign_key});
+
+        my $obj29 = $obj27->loader_test29;
+        isa_ok($obj29, $class29);
+        is($obj29->id, 1);
+
+        ok($class29->column_info('fk')->{is_foreign_key});
+
+        $obj27 = $rsobj27->find(2);
+        is($obj27->loader_test28, undef);
+        is($obj27->loader_test29, undef);
+
+        # test outer join for nullable referring columns:
+        SKIP: {
+          skip "unreliable column info from db driver",11 unless 
+            ($class32->column_info('rel2')->{is_nullable});
+
+          ok($class32->column_info('rel1')->{is_foreign_key});
+          ok($class32->column_info('rel2')->{is_foreign_key});
+          
+          my $obj32 = $rsobj32->find(1,{prefetch=>[qw/rel1 rel2/]});
+          my $obj34 = $rsobj34->find(
+            1,{prefetch=>[qw/loader_test33_id_rel1 loader_test33_id_rel2/]}
+          );
+          my $skip_outerjoin;
+          isa_ok($obj32,$class32) or $skip_outerjoin = 1;
+          isa_ok($obj34,$class34) or $skip_outerjoin = 1;
+
+          ok($class34->column_info('id')->{is_foreign_key});
+          ok($class34->column_info('rel1')->{is_foreign_key});
+          ok($class34->column_info('rel2')->{is_foreign_key});
+
+          SKIP: {
+            skip "Pre-requisite test failed", 4 if $skip_outerjoin;
+            my $rs_rel31_one = $obj32->rel1;
+            my $rs_rel31_two = $obj32->rel2;
+            isa_ok($rs_rel31_one,$class31);
+            is($rs_rel31_two,undef);
+
+            my $rs_rel33_one = $obj34->loader_test33_id_rel1;
+            my $rs_rel33_two = $obj34->loader_test33_id_rel2;
+
+            isa_ok($rs_rel33_one,$class33);
+            is($rs_rel33_two,undef);
+
+          }
+        }
+
         # from Chisel's tests...
         SKIP: {
             if($self->{vendor} =~ /sqlite/i) {
-                skip 'SQLite cannot do the advanced tests', 8;
+                skip 'SQLite cannot do the advanced tests', 10;
             }
 
             my $moniker10 = $monikers->{loader_test10};
@@ -401,6 +521,9 @@ sub run_tests {
             isa_ok( $rsobj10, "DBIx::Class::ResultSet" ); 
             isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
 
+            ok($class10->column_info('loader_test11')->{is_foreign_key});
+            ok($class11->column_info('loader_test10')->{is_foreign_key});
+
             my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
 
             $obj10->update();
@@ -433,7 +556,7 @@ sub run_tests {
         }
 
         SKIP: {
-            skip 'This vendor cannot do inline relationship definitions', 5
+            skip 'This vendor cannot do inline relationship definitions', 8
                 if $self->{no_inline_rels};
 
             my $moniker12 = $monikers->{loader_test12};
@@ -447,6 +570,10 @@ sub run_tests {
             isa_ok( $rsobj12, "DBIx::Class::ResultSet" ); 
             isa_ok( $rsobj13, "DBIx::Class::ResultSet" );
 
+            ok($class13->column_info('id')->{is_foreign_key});
+            ok($class13->column_info('loader_test12')->{is_foreign_key});
+            ok($class13->column_info('dat')->{is_foreign_key});
+
             my $obj13 = $rsobj13->find(1);
             isa_ok( $obj13->id, $class12 );
             isa_ok( $obj13->loader_test12, $class12);
@@ -454,7 +581,7 @@ sub run_tests {
         }
 
         SKIP: {
-            skip 'This vendor cannot do out-of-line implicit rel defs', 3
+            skip 'This vendor cannot do out-of-line implicit rel defs', 4
                 if $self->{no_implicit_rels};
             my $moniker14 = $monikers->{loader_test14};
             my $class14   = $classes->{loader_test14};
@@ -467,6 +594,8 @@ sub run_tests {
             isa_ok( $rsobj14, "DBIx::Class::ResultSet" ); 
             isa_ok( $rsobj15, "DBIx::Class::ResultSet" );
 
+            ok($class15->column_info('loader_test14')->{is_foreign_key});
+
             my $obj15 = $rsobj15->find(1);
             isa_ok( $obj15->loader_test14, $class14 );
         }
@@ -474,7 +603,7 @@ sub run_tests {
 
     # rescan test
     SKIP: {
-        skip $self->{skip_rels}, 4 if $self->{skip_rels};
+        skip $self->{skip_rels}, 5 if $self->{skip_rels};
 
         my @statements_rescan = (
             qq{
@@ -500,7 +629,11 @@ sub run_tests {
         isa_ok($rsobj30, 'DBIx::Class::ResultSet');
         my $obj30 = $rsobj30->find(123);
         isa_ok( $obj30->loader_test2, $class2);
+
+        ok($rsobj30->result_source->column_info('loader_test2')->{is_foreign_key});
     }
+
+    $self->{extra}->{run}->($conn, $monikers, $classes) if $self->{extra}->{run};
 }
 
 sub dbconnect {
@@ -761,6 +894,72 @@ sub create {
 
         q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (33,5,7) },
         q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (3,42,42) },
+
+        qq{
+            CREATE TABLE loader_test27 (
+                id INTEGER NOT NULL PRIMARY KEY
+            ) $self->{innodb}
+        },
+
+        q{ INSERT INTO loader_test27 (id) VALUES (1) },
+        q{ INSERT INTO loader_test27 (id) VALUES (2) },
+
+        qq{
+            CREATE TABLE loader_test28 (
+                id INTEGER NOT NULL PRIMARY KEY,
+                FOREIGN KEY (id) REFERENCES loader_test27 (id)
+            ) $self->{innodb}
+        },
+
+        q{ INSERT INTO loader_test28 (id) VALUES (1) },
+
+        qq{
+            CREATE TABLE loader_test29 (
+                id INTEGER NOT NULL PRIMARY KEY,
+                fk INTEGER UNIQUE,
+                FOREIGN KEY (fk) REFERENCES loader_test27 (id)
+            ) $self->{innodb}
+        },
+
+        q{ INSERT INTO loader_test29 (id,fk) VALUES (1,1) },
+
+        qq{
+          CREATE TABLE loader_test31 (
+            id INTEGER NOT NULL PRIMARY KEY
+          ) $self->{innodb}
+        },
+        q{ INSERT INTO loader_test31 (id) VALUES (1) },
+
+        qq{
+          CREATE TABLE loader_test32 (
+            id INTEGER NOT NULL PRIMARY KEY,
+            rel1 INTEGER NOT NULL,
+            rel2 INTEGER NULL,
+            FOREIGN KEY (rel1) REFERENCES loader_test31(id),
+            FOREIGN KEY (rel2) REFERENCES loader_test31(id)
+          ) $self->{innodb}
+        },
+        q{ INSERT INTO loader_test32 (id,rel1) VALUES (1,1) },
+
+        qq{
+          CREATE TABLE loader_test33 (
+            id1 INTEGER NOT NULL,
+            id2 INTEGER NOT NULL,
+            PRIMARY KEY (id1,id2)
+          ) $self->{innodb}
+        },
+        q{ INSERT INTO loader_test33 (id1,id2) VALUES (1,2) },
+
+        qq{
+          CREATE TABLE loader_test34 (
+            id INTEGER NOT NULL PRIMARY KEY,
+            rel1 INTEGER NOT NULL,
+            rel2 INTEGER NULL,
+            FOREIGN KEY (id,rel1) REFERENCES loader_test33(id1,id2),
+            FOREIGN KEY (id,rel2) REFERENCES loader_test33(id1,id2)
+          ) $self->{innodb}
+        },
+        q{ INSERT INTO loader_test34 (id,rel1) VALUES (1,2) },
     );
 
     my @statements_advanced = (
@@ -859,6 +1058,8 @@ sub create {
             $dbh->do($_) for (@statements_implicit_rels);
         }
     }
+
+    $dbh->do($_) for @{ $self->{extra}->{create} || [] };
     $dbh->disconnect();
 }
 
@@ -894,6 +1095,13 @@ sub drop_tables {
         loader_test21
         loader_test26
         loader_test25
+        loader_test28
+        loader_test29
+        loader_test27
+        loader_test32
+        loader_test31
+        loader_test34
+        loader_test33
     /;
 
     my @tables_advanced = qw/
@@ -926,6 +1134,8 @@ sub drop_tables {
 
     my $dbh = $self->dbconnect(0);
 
+    $dbh->do("DROP TABLE $_") for @{ $self->{extra}->{drop} || [] };
+
     my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {};
 
     unless($self->{skip_rels}) {