Warn on signs of Moose-borkage (in case it gets to be the first new())

diff --git a/Changes b/Changes
index 5283890..4550819 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for DBIx::Class
 
+    * New Features / Changes
+        - Debugging aid - warn on invalid result objects created by what
+          seems like an invalid inheritance hierarchy
+
     * Fixes
         - Fix another embarrassing regression preventing correct refining of
           the search criteria on a prefetched relation (broken in 0.08205)

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index b5397b6..60d0d92 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -5,7 +5,7 @@ use warnings;
 use base qw/DBIx::Class/;
 use DBIx::Class::Carp;
 use DBIx::Class::ResultSetColumn;
-use Scalar::Util qw/blessed weaken/;
+use Scalar::Util qw/blessed weaken reftype/;
 use Try::Tiny;
 use Data::Compare (); # no imports!!! guard against insane architecture
 
@@ -2324,15 +2324,29 @@ sub new_result {
 
   my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
 
-  my %new = (
+  my $new = $self->result_class->new({
     %$merged_cond,
-    @$cols_from_relations
+    ( @$cols_from_relations
       ? (-cols_from_relations => $cols_from_relations)
-      : (),
+      : ()
+    ),
     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
-  );
+  });
+
+  if (
+    reftype($new) eq 'HASH'
+      and
+    ! keys %$new
+      and
+    blessed($new)
+  ) {
+    carp_unique (sprintf (
+      "%s->new returned a blessed empty hashref - a strong indicator something is wrong with its inheritance chain",
+      $self->result_class,
+    ));
+  }
 
-  return $self->result_class->new(\%new);
+  $new;
 }
 
 # _merge_with_rscond