Merge pull request #19 from simbabque/fix-magical-bug

fix broken missing method detection for Perl >= 5.18
chizmw · Jun 11, 2017 · 4404290 · 4404290
2 parents 56b1feb + cd2b2b3
commit 4404290
Show file tree

Hide file tree

Showing 3 changed files with 43 additions and 49 deletions.
diff --git a/lib/Test/DBIx/Class/Schema.pm b/lib/Test/DBIx/Class/Schema.pm
@@ -98,7 +98,7 @@ sub _test_normal_methods {
     my @proxied;
     foreach my $method_type (@std_method_types) {
         SKIP: {
-            if (not @{ $self->{methods}{$method_type} }) {
+            if (not exists $self->{methods}{$method_type} or not @{ $self->{methods}{$method_type} }) {
                 skip qq{no $method_type methods}, 1;
             }
 
@@ -245,28 +245,34 @@ sub _test_unexpected_normal_methods {
     };
 
     foreach my $method_type (sort keys %{$set}) {
-        my @diff = $self->_diff_arrays(
-            $self->{methods}->{$method_type},
-            $set->{$method_type},
-        );
+        SKIP: {
+            if (not exists $self->{methods}->{$method_type} or not @{ $self->{methods}->{$method_type} }) {
+                skip qq{no $method_type methods}, 1;
+            }
 
-        my $plural = (scalar @diff == 1) ? '' : 's';
-        my $message =
-            qq{'$method_type' method${plural} defined in }
-            . $self->{moniker}
-            . ' but untested: '
-            . join(', ',@diff);
-
-        if ($self->{test_missing}) {
-            is_deeply(
-                \@diff,
-                [],
-                "All known $method_type method${plural} defined in test"
-            ) || diag $message;
-        }
-        else {
-            if (scalar @diff) {
-               diag $message;
+            my @diff = $self->_diff_arrays(
+                $self->{methods}->{$method_type},
+                $set->{$method_type},
+            );
+
+            my $plural = (scalar @diff == 1) ? '' : 's';
+            my $message =
+                qq{'$method_type' method${plural} defined in }
+                . $self->{moniker}
+                . ' but untested: '
+                . join(', ',@diff);
+
+            if ($self->{test_missing}) {
+                is_deeply(
+                    \@diff,
+                    [],
+                    "All known $method_type method${plural} defined in test"
+                ) || diag $message;
+            }
+            else {
+                if (scalar @diff) {
+                   diag $message;
+                }
             }
         }
     }

diff --git a/t/30.missing_methods.t b/t/30.missing_methods.t
@@ -26,12 +26,6 @@ my $schematest = Test::DBIx::Class::Schema->new({
 
 # tell it what to test
 $schematest->methods({
-    columns => [qw(
-        artistid
-        personid
-        name
-    )],
-
     relations => [qw(
         person
         cds
@@ -40,12 +34,8 @@ $schematest->methods({
     custom => [
     ],
 
+    # we have missed the 'columns' option
     # we have missed the 'resultsets' option
-    # this used to pass (magically? quietly?) in perl <5.18
-    # it now complains with:
-    #    Can't use an undefined value as an ARRAY reference at
-    #    /opt/xt/xt-perl/lib/site_perl/5.18.1/Test/DBIx/Class/Schema.pm line
-    #    221
 });
 
 # stop TDCS from doing done_testing on our behalf
@@ -64,21 +54,17 @@ test_out(
     q{ok 1 - use TDCSTest::Schema;},
     $isa_expected,
     q{ok 3 - The record object is a ::Artist},
-    q{ok 4 - 'artistid' column defined in result_source},
-    q{ok 5 - 'artistid' column exists in database},
-    q{ok 6 - 'personid' column defined in result_source},
-    q{ok 7 - 'personid' column exists in database},
-    q{ok 8 - 'name' column defined in result_source},
-    q{ok 9 - 'name' column exists in database},
-    q{ok 10 - related source for 'person' exists},
-    q{ok 11 - self.personid valid for 'person' relationship},
-    q{ok 12 - foreign.personid valid for 'person' relationship},
-    q{ok 13 - related source for 'cds' exists},
-    q{ok 14 - self.artistid valid for 'cds' relationship},
-    q{ok 15 - foreign.artistid valid for 'cds' relationship},
-    q{ok 16 # skip no custom methods},
-    q{ok 17 # skip no resultsets methods},
-    q{ok 18 - test survives with missing method in config},
+    q{ok 4 # skip no columns methods},
+    q{ok 5 - related source for 'person' exists},
+    q{ok 6 - self.personid valid for 'person' relationship},
+    q{ok 7 - foreign.personid valid for 'person' relationship},
+    q{ok 8 - related source for 'cds' exists},
+    q{ok 9 - self.artistid valid for 'cds' relationship},
+    q{ok 10 - foreign.artistid valid for 'cds' relationship},
+    q{ok 11 # skip no custom methods},
+    q{ok 12 # skip no resultsets methods},
+    q{ok 13 # skip no columns methods},
+    q{ok 14 - test survives with missing method in config},
 );
 
 test_err(

diff --git a/t/40.untested.columns.t b/t/40.untested.columns.t
@@ -50,14 +50,15 @@ my @expected_out = (
     q{ok 8 # skip no relations methods},
     q{ok 9 # skip no custom methods},
     q{ok 10 # skip no resultsets methods},
+    q{ok 11 # skip no relations methods},
 );
 
 # we really need to work out why this is happening ... and MAKE IT STOP
 # I think that Test::Builder::Tester plans are getting mixed up with the
 # actual test plans ...
 if (1) {
     push @expected_out,
-         q{not ok 11 - planned to run 4 but done_testing() expects 10}
+         q{not ok 12 - planned to run 4 but done_testing() expects 11}
     ;
 }
 
@@ -91,6 +92,7 @@ FORGOT_TO_TEST: {
         q{ok 6 # skip no relations methods},
         q{ok 7 # skip no custom methods},
         q{ok 8 # skip no resultsets methods},
+        q{ok 9 # skip no relations methods},
     );
 
     test_err(