Ignore duplicate uniq indices (including duplicates of the PK).

[Originally committed as r5766 to trunk by mistake]

diff --git a/Changes b/Changes
index 1d52a89..3961b8e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,6 +2,7 @@ Revision history for Perl extension DBIx::Class::Schema::Loader
 
 0.04999_07 Not Yet Released
         - Add result_base_class and schema_base_class options (RT #43977)
+        - Ignore duplicate uniq indices (including duplicates of the PK).
 
 0.04999_06 Tue Nov 11, 2008
         - Singularise table monikers by default

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 13c6bae..54cbf12 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -685,12 +685,20 @@ sub _setup_src_meta {
         );
     }
 
+    my %uniq_tag; # used to eliminate duplicate uniqs
+
     my $pks = $self->_table_pk_info($table) || [];
     @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
           : carp("$table has no primary key");
+    $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
 
     my $uniqs = $self->_table_uniq_info($table) || [];
-    $self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
+    for (@$uniqs) {
+        my ($name, $cols) = @$_;
+        next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
+        $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
+    }
+
 }
 
 =head2 tables

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index cd42be8..c749b8e 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -51,7 +51,7 @@ sub _monikerize {
 sub run_tests {
     my $self = shift;
 
-    plan tests => 3 + 2 * (132 + ($self->{extra}->{count} || 0));
+    plan tests => 3 + 2 * (134 + ($self->{extra}->{count} || 0));
 
     $self->create();
 
@@ -148,10 +148,12 @@ sub test_schema {
     my $moniker1 = $monikers->{loader_test1s};
     my $class1   = $classes->{loader_test1s};
     my $rsobj1   = $conn->resultset($moniker1);
+    check_no_duplicate_unique_constraints($class1);
 
     my $moniker2 = $monikers->{loader_test2};
     my $class2   = $classes->{loader_test2};
     my $rsobj2   = $conn->resultset($moniker2);
+    check_no_duplicate_unique_constraints($class2);
 
     my $moniker23 = $monikers->{LOADER_TEST23};
     my $class23   = $classes->{LOADER_TEST23};
@@ -649,6 +651,19 @@ sub test_schema {
     $self->{extra}->{run}->($conn, $monikers, $classes) if $self->{extra}->{run};
 }
 
+sub check_no_duplicate_unique_constraints {
+    my ($class) = @_;
+
+    # unique_constraints() automatically includes the PK, if any
+    my %uc_cols;
+    ++$uc_cols{ join ", ", @$_ }
+        for values %{ { $class->unique_constraints } };
+    my $dup_uc = grep { $_ > 1 } values %uc_cols;
+
+    is($dup_uc, 0, "duplicate unique constraints ($class)")
+        or diag "uc_cols: @{[ %uc_cols ]}";
+}
+
 sub dbconnect {
     my ($self, $complain) = @_;