WIP

frioux · Oct 16, 2013 · ce68f2e · ce68f2e
1 parent f369ca6
commit ce68f2e
Show file tree

Hide file tree

Showing 25 changed files with 613 additions and 568 deletions.
diff --git a/cpanfile b/cpanfile
@@ -13,4 +13,5 @@ on test => sub {
    requires 'Test::Deep' => 0;
    requires 'DBD::SQLite' => 0;
    requires 'Test::Exception' => 0;
+   requires 'Test::Roo' => 0;
 };
diff --git a/lib/A/Does/TestSchema.pm b/lib/A/Does/TestSchema.pm
@@ -0,0 +1,20 @@
+package A::Does::TestSchema;
+
+use Moo::Role;
+use lib 't/lib';
+use TestSchema;
+
+has schema => (
+   is => 'ro',
+   lazy => 1,
+   builder => 'build_schema',
+   clearer => 'reset_schema',
+);
+
+sub build_schema {
+   my $schema = TestSchema->deploy_or_connect();
+   $schema->prepopulate unless $_[0]->can('no_deploy');
+   $schema
+}
+
+1;
diff --git a/t/resultset/attribute-accessors.t b/t/resultset/attribute-accessors.t
@@ -1,85 +1,85 @@
 #!perl
 
-use strict;
-use warnings;
-
 use lib 't/lib';
 use Test::More;
-use Test::Deep;
-
-use TestSchema;
-my $schema = TestSchema->deploy_or_connect();
-$schema->prepopulate;
-
-my $rs = $schema->resultset('Foo');
-
-my $dupes_rs = $rs->search({}, { join => 'bars' });
-
-ok($dupes_rs->has_rows, 'check rs has rows');
-
-cmp_deeply
-   [$dupes_rs->distinct->all],
-   [$dupes_rs->search({},{distinct => 1})->all],
-   'distinct works the same';
-
-cmp_deeply
-   [$dupes_rs->group_by(['me.id'])->all],
-   [$dupes_rs->search({},{group_by => ['me.id']})->all],
-   'group_by works the same';
-
-cmp_deeply
-   [$dupes_rs->order_by({ -desc => 'me.id' })->all],
-   [$dupes_rs->search({},{order_by => { -desc => 'me.id' }})->all],
-   'hashref order_by works the same';
-
-cmp_deeply
-   [$dupes_rs->order_by(['me.id'])->all],
-   [$dupes_rs->search({},{order_by => { -asc => 'me.id' }})->all],
-   'arrayref order_by works the same';
-
-cmp_deeply
-   [$dupes_rs->hri->all],
-   [$dupes_rs->search({},{
-       result_class => 'DBIx::Class::ResultClass::HashRefInflator'
-   })->all],
-   'hri works the same';
-
-cmp_deeply
-   [$dupes_rs->rows(2)->all],
-   [$dupes_rs->search({},{rows => 2})->all],
-   'rows works the same';
-
-cmp_deeply
-   [$dupes_rs->rows(2)->all],
-   [$dupes_rs->limit(2)->all],
-   'limit works the same';
-
-cmp_deeply
-   [$dupes_rs->columns(['bar_id'])->all],
-   [$dupes_rs->search({},{columns => ['bar_id']})->all],
-   'columns works the same';
-
-cmp_deeply
-   [$dupes_rs->prefetch('bar')->all],
-   [$dupes_rs->search({},{prefetch => 'bar' })->all],
-   'prefetch works the same';
-
-## Extended order_by syntax test
-my %tests = (
-    'id'         => [{ -asc => 'me.id' }],
-    '!id'        => [{ -desc => 'me.id' }],
-    'id,!bar_id'   => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
-    'id, !bar_id'  => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
-    'id ,!bar_id'  => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
-    'id , !bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
-);
-
-while (my ($order, $expect) = each(%tests)) {
+use Test::Deep 'cmp_deeply';
+
+use Test::Roo;
+with 'A::Does::TestSchema';
+
+test basic => sub {
+   my $schema = shift->schema;
+
+   my $rs = $schema->resultset('Foo');
+
+   my $dupes_rs = $rs->search({}, { join => 'bars' });
+
+   ok($dupes_rs->has_rows, 'check rs has rows');
+
    cmp_deeply
-      [$dupes_rs->order_by($order)->all],
-      [$dupes_rs->search({},{order_by => $expect})->all],
-      "order_by works: $order";
-}
+      [$dupes_rs->distinct->all],
+      [$dupes_rs->search({},{distinct => 1})->all],
+      'distinct works the same';
 
-done_testing;
+   cmp_deeply
+      [$dupes_rs->group_by(['me.id'])->all],
+      [$dupes_rs->search({},{group_by => ['me.id']})->all],
+      'group_by works the same';
 
+   cmp_deeply
+      [$dupes_rs->order_by({ -desc => 'me.id' })->all],
+      [$dupes_rs->search({},{order_by => { -desc => 'me.id' }})->all],
+      'hashref order_by works the same';
+
+   cmp_deeply
+      [$dupes_rs->order_by(['me.id'])->all],
+      [$dupes_rs->search({},{order_by => { -asc => 'me.id' }})->all],
+      'arrayref order_by works the same';
+
+   cmp_deeply
+      [$dupes_rs->hri->all],
+      [$dupes_rs->search({},{
+          result_class => 'DBIx::Class::ResultClass::HashRefInflator'
+      })->all],
+      'hri works the same';
+
+   cmp_deeply
+      [$dupes_rs->rows(2)->all],
+      [$dupes_rs->search({},{rows => 2})->all],
+      'rows works the same';
+
+   cmp_deeply
+      [$dupes_rs->rows(2)->all],
+      [$dupes_rs->limit(2)->all],
+      'limit works the same';
+
+   cmp_deeply
+      [$dupes_rs->columns(['bar_id'])->all],
+      [$dupes_rs->search({},{columns => ['bar_id']})->all],
+      'columns works the same';
+
+   cmp_deeply
+      [$dupes_rs->prefetch('bar')->all],
+      [$dupes_rs->search({},{prefetch => 'bar' })->all],
+      'prefetch works the same';
+
+   ## Extended order_by syntax test
+   my %tests = (
+       'id'         => [{ -asc => 'me.id' }],
+       '!id'        => [{ -desc => 'me.id' }],
+       'id,!bar_id'   => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
+       'id, !bar_id'  => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
+       'id ,!bar_id'  => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
+       'id , !bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }],
+   );
+
+   while (my ($order, $expect) = each(%tests)) {
+      cmp_deeply
+         [$dupes_rs->order_by($order)->all],
+         [$dupes_rs->search({},{order_by => $expect})->all],
+         "order_by works: $order";
+   }
+};
+
+run_me;
+done_testing;
diff --git a/t/resultset/correlate-relationship.t b/t/resultset/correlate-relationship.t
@@ -1,56 +1,57 @@
 #!perl
 
-use strict;
-use warnings;
-
 use lib 't/lib';
 use Test::More;
-use Test::Deep;
+use Test::Deep 'cmp_deeply';
+
+use Test::Roo;
+with 'A::Does::TestSchema';
 
-use TestSchema;
-my $schema = TestSchema->deploy_or_connect();
-$schema->prepopulate;
+test 'simple json' => sub {
+   my $schema = shift->schema;
 
-my $rs = $schema->resultset('Gnarly')->search(undef, {
-   '+columns' => {
-      old_gnarlies => $schema->resultset('Gnarly')
-         ->correlate('gnarly_stations')
-         ->search({ station_id => { '>' => 2 }})
-         ->count_rs->as_query,
-      new_gnarlies => $schema->resultset('Gnarly')
-         ->correlate('gnarly_stations')
-         ->search({ station_id => { '<=' => 2 }})
-         ->count_rs->as_query,
-   },
-   result_class => '::HRI',
-});
+   my $rs = $schema->resultset('Gnarly')->search(undef, {
+      '+columns' => {
+         old_gnarlies => $schema->resultset('Gnarly')
+            ->correlate('gnarly_stations')
+            ->search({ station_id => { '>' => 2 }})
+            ->count_rs->as_query,
+         new_gnarlies => $schema->resultset('Gnarly')
+            ->correlate('gnarly_stations')
+            ->search({ station_id => { '<=' => 2 }})
+            ->count_rs->as_query,
+      },
+      result_class => '::HRI',
+   });
 
-cmp_deeply([$rs->all], [
-  {
-    id => 1,
-    literature => undef,
-    name => "frew",
-    new_gnarlies => 1,
-    old_gnarlies => 1,
-    your_mom => undef
-  },
-  {
-    id => 2,
-    literature => undef,
-    name => "frioux",
-    new_gnarlies => 1,
-    old_gnarlies => 0,
-    your_mom => undef
-  },
-  {
-    id => 3,
-    literature => undef,
-    name => "frooh",
-    new_gnarlies => 1,
-    old_gnarlies => 0,
-    your_mom => undef
-  }
+   cmp_deeply([$rs->all], [
+     {
+       id => 1,
+       literature => undef,
+       name => "frew",
+       new_gnarlies => 1,
+       old_gnarlies => 1,
+       your_mom => undef
+     },
+     {
+       id => 2,
+       literature => undef,
+       name => "frioux",
+       new_gnarlies => 1,
+       old_gnarlies => 0,
+       your_mom => undef
+     },
+     {
+       id => 3,
+       literature => undef,
+       name => "frooh",
+       new_gnarlies => 1,
+       old_gnarlies => 0,
+       your_mom => undef
+     }
 
-], 'relationship correlated correctly');
+   ], 'relationship correlated correctly');
+};
 
+run_me;
 done_testing;
diff --git a/t/resultset/ignore-wantarray.t b/t/resultset/ignore-wantarray.t
@@ -1,23 +1,24 @@
 #!perl
 
-use strict;
-use warnings;
-
 use lib 't/lib';
 use Test::More;
 
-use TestSchema;
-my $schema = TestSchema->deploy_or_connect();
-$schema->prepopulate;
+use Test::Roo;
+with 'A::Does::TestSchema';
+
+test basic => sub {
+   my $schema = shift->schema;
 
-my ($rs) = $schema->resultset('Foo')->search;
-my ($rs2) = $schema->resultset('Bar')->search;
-my ($rs3) = $schema->resultset('Foo')->first->bars;
-my ($rs4) = $schema->resultset('Bar')->first->foos;
+   my ($rs) = $schema->resultset('Foo')->search;
+   my ($rs2) = $schema->resultset('Bar')->search;
+   my ($rs3) = $schema->resultset('Foo')->first->bars;
+   my ($rs4) = $schema->resultset('Bar')->first->foos;
 
-isa_ok $rs, 'DBIx::Class::ResultSet';
-isa_ok $rs2, 'DBIx::Class::ResultSet';
-isa_ok $rs3, 'DBIx::Class::ResultSet';
-isa_ok $rs4, 'DBIx::Class::ResultSet';
+   isa_ok $rs, 'DBIx::Class::ResultSet';
+   isa_ok $rs2, 'DBIx::Class::ResultSet';
+   isa_ok $rs3, 'DBIx::Class::ResultSet';
+   isa_ok $rs4, 'DBIx::Class::ResultSet';
+};
 
+run_me;
 done_testing;
diff --git a/t/resultset/me.t b/t/resultset/me.t
@@ -1,18 +1,21 @@
 #!perl
 
-use strict;
-use warnings;
-
 use lib 't/lib';
 use Test::More;
 
-use TestSchema;
-my $schema = TestSchema->deploy_or_connect();
+use Test::Roo;
+with 'A::Does::TestSchema';
+sub no_deploy {}
+
+test basic => sub {
+   my $schema = shift->schema;
 
-my $rs = $schema->resultset('Gnarly');
-my $alias = $rs->current_source_alias;
+   my $rs = $schema->resultset('Gnarly');
+   my $alias = $rs->current_source_alias;
 
-is $rs->me, "$alias.", 'me without args';
-is $rs->me('col'), "$alias.col", 'me with args';
+   is $rs->me, "$alias.", 'me without args';
+   is $rs->me('col'), "$alias.col", 'me with args';
+};
 
+run_me;
 done_testing;
diff --git a/t/resultset/no-columns.t b/t/resultset/no-columns.t
@@ -1,20 +1,21 @@
 #!perl
 
-use strict;
-use warnings;
-
 use lib 't/lib';
 use Test::More;
-use Test::Deep;
+use Test::Deep 'cmp_deeply';
+
+use Test::Roo;
+with 'A::Does::TestSchema';
 
-use TestSchema;
-my $schema = TestSchema->deploy_or_connect();
-$schema->prepopulate;
+test basic => sub {
+   my $schema = shift->schema;
 
-my $rs = $schema->resultset('Gnarly')->no_columns->search(undef, {
-   result_class => '::HRI',
-});
+   my $rs = $schema->resultset('Gnarly')->no_columns->search(undef, {
+      result_class => '::HRI',
+   });
 
-cmp_deeply([$rs->all], [ { }, { }, { } ], 'no columns selected');
+   cmp_deeply([$rs->all], [ { }, { }, { } ], 'no columns selected');
+};
 
+run_me;
 done_testing;