Explicitly test that prefetched rels get inflated by HRI

[dbsrgits/DBIx-Class.git] / t / inflate / hri.t

diff --git a/t/inflate/hri.t b/t/inflate/hri.t
index 1dca9c2..f780696 100644 (file)
--- a/t/inflate/hri.t
+++ b/t/inflate/hri.t
@@ -1,9 +1,19 @@
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
 use strict;
 use warnings;
 
 use Test::More;
+
+use DBIx::Class::_Util 'modver_gt_or_eq_and_lt';
+use base();
+BEGIN {
+  plan skip_all => 'base.pm 2.20 (only present in perl 5.19.7) is known to break this test'
+    if modver_gt_or_eq_and_lt( 'base', '2.19_01', '2.21' );
+}
+
 use Test::Exception;
-use lib qw(t/lib);
+
 use DBICTest;
 my $schema = DBICTest->init_schema();
 
@@ -34,13 +44,13 @@ my $schema = DBICTest->init_schema();
     is ($rs->result_class, 'DBICTest::CDSubclass', 'original class unchanged');
     is ($hri_rs->result_class, 'DBIx::Class::ResultClass::HashRefInflator', 'result_class accessor pre-set via attribute');
 
-
     my $datahashref1 = $hri_rs->next;
     is_deeply(
       [ sort keys %$datahashref1 ],
       [ sort $rs->result_source->columns ],
       'returned correct columns',
     );
+    $hri_rs->reset;
 
     $cd = $hri_rs->find ({cdid => 1});
     is_deeply ( $cd, $datahashref1, 'first/find return the same thing (result_class attr propagates)');
@@ -71,33 +81,43 @@ my $schema = DBICTest->init_schema();
 }
 
 sub check_cols_of {
-    my ($dbic_obj, $datahashref) = @_;
+    my ($dbic_obj, $datahashref, $prefetch, $prefix) = @_;
+
+    $prefetch ||= [];
+    $prefix ||= '';
+    my %prefetch; @prefetch{@$prefetch} = ();
 
     foreach my $col (keys %$datahashref) {
         # plain column
         if (not ref ($datahashref->{$col}) ) {
-            is ($datahashref->{$col}, $dbic_obj->get_column($col), 'same value');
+            is ($datahashref->{$col}, $dbic_obj->get_column($col), "value for $prefix$col");
         }
         # related table entry (belongs_to)
         elsif (ref ($datahashref->{$col}) eq 'HASH') {
-            check_cols_of($dbic_obj->$col, $datahashref->{$col});
+            delete $prefetch{$col};
+            check_cols_of($dbic_obj->$col, $datahashref->{$col}, [], "$col.");
         }
         # multiple related entries (has_many)
         elsif (ref ($datahashref->{$col}) eq 'ARRAY') {
+            delete $prefetch{$col};
             my @dbic_reltable = $dbic_obj->$col;
             my @hashref_reltable = @{$datahashref->{$col}};
 
-            is (scalar @hashref_reltable, scalar @dbic_reltable, 'number of related entries');
+            is (scalar @hashref_reltable, scalar @dbic_reltable, "number of related $col");
 
             # for my $index (0..scalar @hashref_reltable) {
             for my $index (0..scalar @dbic_reltable) {
                 my $dbic_reltable_obj       = $dbic_reltable[$index];
                 my $hashref_reltable_entry  = $hashref_reltable[$index];
 
-                check_cols_of($dbic_reltable_obj, $hashref_reltable_entry);
+                check_cols_of($dbic_reltable_obj, $hashref_reltable_entry, [], "$col\[$index\].");
             }
         }
     }
+    if (@$prefetch) {
+        is 0+(keys %prefetch), 0, "prefetched " . join ", ", @$prefetch
+          or diag "missed: " . join ", ", keys %prefetch;
+    }
 }
 
 # create a cd without tracks for testing empty has_many relationship
@@ -126,7 +146,7 @@ for my $index (0 .. $#hashrefinf) {
     my $dbic_obj    = $dbic[$index];
     my $datahashref = $hashrefinf[$index];
 
-    check_cols_of($dbic_obj, $datahashref);
+    check_cols_of($dbic_obj, $datahashref, [qw(artist tracks)]);
 }
 
 # sometimes for ultra-mega-speed you want to fetch columns in esoteric ways