From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 17 Jun 2014 10:41:06 +0000 (+0200)
Subject: Add a self-explanatory *compile-time* $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS}
X-Git-Tag: v0.082800~167
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1b658919f5ff67e9ac656daf6642a3bae8cec282;hp=e6ed824bbb02cbe1dfdc18987f468791af228e63;p=dbsrgits%2FDBIx-Class.git

Add a self-explanatory *compile-time* $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS}

The idea is to be able to catch tests that rely on a particular order of
the results of ->all. ->next is untouched as injecting extra \'RANDOM'
order clauses is too heavy-handed for a test environment (and besides, having
->all and ->next return stuff in differing order is just as good of a
monkey-wrench)
---

diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm
index 6681d23..4d15401 100644
--- a/lib/DBIx/Class/Storage/DBI/Cursor.pm
+++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm
@@ -3,10 +3,11 @@ package DBIx::Class::Storage::DBI::Cursor;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class::Cursor/;
+use base 'DBIx::Class::Cursor';
 
 use Try::Tiny;
-use Scalar::Util qw/refaddr weaken/;
+use Scalar::Util qw(refaddr weaken);
+use List::Util 'shuffle';
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors('simple' =>
@@ -177,7 +178,14 @@ sub all {
 
   (undef, $sth) = $self->storage->_select( @{$self->{args}} );
 
-  return @{$sth->fetchall_arrayref};
+  return (
+    DBIx::Class::_ENV_::SHUFFLE_UNORDERED_RESULTSETS
+      and
+    ! $self->{attrs}{order_by}
+  )
+    ? shuffle @{$sth->fetchall_arrayref}
+    : @{$sth->fetchall_arrayref}
+  ;
 }
 
 sub sth {
diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 7cf6a52..ad438e7 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -26,6 +26,8 @@ BEGIN {
     # add an escape for these perls ON SMOKERS - a user will still get death
     PEEPEENESS => ( eval { DBICTest::RunMode->is_smoker } && ($] >= 5.013005 and $] <= 5.013006) ),
 
+    SHUFFLE_UNORDERED_RESULTSETS => $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} ? 1 : 0,
+
     ASSERT_NO_INTERNAL_WANTARRAY => $ENV{DBIC_ASSERT_NO_INTERNAL_WANTARRAY} ? 1 : 0,
 
     IV_SIZE => $Config{ivsize},
diff --git a/t/104view.t b/t/104view.t
index a13ea00..4abe7e8 100644
--- a/t/104view.t
+++ b/t/104view.t
@@ -29,6 +29,7 @@ is_deeply (
       {
         result_class => 'DBIx::Class::ResultClass::HashRefInflator',
         prefetch => ['artist', { tracks => [qw/cd year1999cd year2000cd/] } ],
+        order_by => 'tracks.trackid',
       },
     )->all
   ],
@@ -39,6 +40,7 @@ is_deeply (
         result_class => 'DBIx::Class::ResultClass::HashRefInflator',
         prefetch => ['artist', { tracks => [qw/cd year1999cd year2000cd/] } ],
         columns => [qw/cdid single_track title/],   # to match the columns retrieved by the virtview
+        order_by => 'tracks.trackid',
       },
     )->all
   ],
diff --git a/t/71mysql.t b/t/71mysql.t
index bebbc4b..ef2c7de 100644
--- a/t/71mysql.t
+++ b/t/71mysql.t
@@ -352,8 +352,8 @@ ZEROINSEARCH: {
   ]});
 
   warnings_exist { is_deeply (
-    [ $restrict_rs->get_column('y')->all ],
-    [ $y_rs->all ],
+    [ sort $restrict_rs->get_column('y')->all ],
+    [ sort $y_rs->all ],
     'Zero year was correctly excluded from resultset',
   ) } qr/
     \QUse of distinct => 1 while selecting anything other than a column \E
diff --git a/t/73oracle_hq.t b/t/73oracle_hq.t
index 0595edf..6d27a05 100644
--- a/t/73oracle_hq.t
+++ b/t/73oracle_hq.t
@@ -3,6 +3,12 @@ use warnings;
 
 use Test::Exception;
 use Test::More;
+
+# I *strongly* suspect Oracle has an implicit stable output order when
+# dealing with HQs. So just punt on the entire shuffle thing.
+BEGIN { $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} = 0 }
+
+
 use DBIx::Class::Optional::Dependencies ();
 use lib qw(t/lib);
 
diff --git a/t/746mssql.t b/t/746mssql.t
index 5e062f6..e4a9de0 100644
--- a/t/746mssql.t
+++ b/t/746mssql.t
@@ -280,8 +280,8 @@ SQL
           my $sealed_owners = $owners->as_subselect_rs;
 
           is_deeply (
-            [ map { $_->name } ($sealed_owners->all) ],
-            [ map { $_->name } ($owners->all) ],
+            [ sort map { $_->name } ($sealed_owners->all) ],
+            [ sort map { $_->name } ($owners->all) ],
             "$test_type: Sort preserved from within a subquery",
           );
         }
diff --git a/t/88result_set_column.t b/t/88result_set_column.t
index 9a04bd1..21e1c9c 100644
--- a/t/88result_set_column.t
+++ b/t/88result_set_column.t
@@ -4,6 +4,12 @@ use warnings;
 use Test::More;
 use Test::Warn;
 use Test::Exception;
+
+# MASSIVE FIXME - there is a hole in ::RSC / as_subselect_rs
+# losing the order. Needs a rework/extract of the realiaser,
+# and that's a whole another bag of dicks
+BEGIN { $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} = 0 }
+
 use lib qw(t/lib);
 use DBICTest ':DiffSQL';
 
diff --git a/t/cdbi/testlib/DBIC/Test/SQLite.pm b/t/cdbi/testlib/DBIC/Test/SQLite.pm
index 5dc4a66..905ed88 100644
--- a/t/cdbi/testlib/DBIC/Test/SQLite.pm
+++ b/t/cdbi/testlib/DBIC/Test/SQLite.pm
@@ -36,6 +36,11 @@ use warnings;
 
 use Test::More;
 
+# adding implicit search criteria to the iterator will alter the test
+# mechanics - leave everything as-is instead, and hope SQLite won't
+# change too much
+BEGIN { $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} = 0 }
+
 use lib 't/lib';
 use DBICTest;
 
diff --git a/t/prefetch/correlated.t b/t/prefetch/correlated.t
index 6c2e0b7..fdbd262 100644
--- a/t/prefetch/correlated.t
+++ b/t/prefetch/correlated.t
@@ -13,7 +13,7 @@ my $cdrs = $schema->resultset('CD')->search({ 'me.artist' => { '!=', 2 }});
 my $cd_data = { map {
   $_->cdid => {
     siblings => $cdrs->search ({ artist => $_->get_column('artist') })->count - 1,
-    track_titles => [ map { $_->title } ($_->tracks->all) ],
+    track_titles => [ sort $_->tracks->get_column('title')->all ],
   },
 } ( $cdrs->all ) };
 
@@ -65,7 +65,7 @@ $schema->is_executed_querycount( sub {
   cmp_deeply (
     { map
       { $_->cdid => {
-        track_titles => [ map { $_->title } ($_->tracks->all) ],
+        track_titles => [ sort map { $_->title } ($_->tracks->all) ],
         siblings => $_->get_column ('sibling_count'),
       } }
       $c_rs->all
diff --git a/t/prefetch/grouped.t b/t/prefetch/grouped.t
index a1b9860..0f6f59a 100644
--- a/t/prefetch/grouped.t
+++ b/t/prefetch/grouped.t
@@ -23,10 +23,12 @@ for ($cd_rs->all) {
   is ($_->tracks->count, 3, '3 tracks for CD' . $_->id );
 }
 
+my @cdids = sort $cd_rs->get_column ('cdid')->all;
+
 # Test a belongs_to prefetch of a has_many
 {
   my $track_rs = $schema->resultset ('Track')->search (
-    { 'me.cd' => { -in => [ $cd_rs->get_column ('cdid')->all ] } },
+    { 'me.cd' => { -in => \@cdids } },
     {
       select => [
         'me.cd',
@@ -72,7 +74,7 @@ for ($cd_rs->all) {
       me
     )',
     [ map { [ { sqlt_datatype => 'integer', dbic_colname => 'me.cd' }
-      => $_ ] } ($cd_rs->get_column ('cdid')->all) ],
+      => $_ ] } @cdids ],
     'count() query generated expected SQL',
   );
 
@@ -91,7 +93,7 @@ for ($cd_rs->all) {
       WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
     )',
     [ map { [ { sqlt_datatype => 'integer', dbic_colname => 'me.cd' }
-      => $_ ] } ( ($cd_rs->get_column ('cdid')->all) x 2 ) ],
+      => $_ ] } (@cdids) x 2 ],
     'next() query generated expected SQL',
   );
 
@@ -283,7 +285,7 @@ for ($cd_rs->all) {
 # RT 47779, test group_by as a scalar ref
 {
   my $track_rs = $schema->resultset ('Track')->search (
-    { 'me.cd' => { -in => [ $cd_rs->get_column ('cdid')->all ] } },
+    { 'me.cd' => { -in => \@cdids } },
     {
       select => [
         'me.cd',
@@ -312,7 +314,7 @@ for ($cd_rs->all) {
       me
     )',
     [ map { [ { sqlt_datatype => 'integer', dbic_colname => 'me.cd' }
-      => $_ ] } ($cd_rs->get_column ('cdid')->all) ],
+      => $_ ] } (@cdids) ],
     'count() query generated expected SQL',
   );
 }
diff --git a/t/prefetch/via_search_related.t b/t/prefetch/via_search_related.t
index f1aa3d0..316035d 100644
--- a/t/prefetch/via_search_related.t
+++ b/t/prefetch/via_search_related.t
@@ -185,7 +185,7 @@ lives_ok (sub {
   });
 
   is_deeply(
-    $rs->all_hri,
+    $rs->search({}, { order_by => 'me.title' })->all_hri,
     [
       { title => "Caterwaulin' Blues", max_trk => 3 },
       { title => "Come Be Depressed With Us", max_trk => 3 },
diff --git a/t/resultset/update_delete.t b/t/resultset/update_delete.t
index c3e8c2f..7d9efa9 100644
--- a/t/resultset/update_delete.t
+++ b/t/resultset/update_delete.t
@@ -5,6 +5,11 @@ use lib qw(t/lib);
 use Test::More;
 use Test::Exception;
 
+# MASSIVE FIXME - there is a hole in ::RSC / as_subselect_rs
+# losing the order. Needs a rework/extract of the realiaser,
+# and that's a whole another bag of dicks
+BEGIN { $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} = 0 }
+
 use DBICTest::Schema::CD;
 BEGIN {
   # the default scalarref table name will not work well for this test
@@ -31,7 +36,7 @@ my ($fa, $fb, $fc) = $tkfks->related_resultset ('fourkeys')->populate ([
 #  [qw/2       2  /],
 #]);
 my ($ta, $tb) = $schema->resultset ('TwoKeys')
-                  ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ])
+                  ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ], { order_by => 'artist' })
                     ->all;
 
 my $tkfk_cnt = $tkfks->count;
@@ -73,7 +78,10 @@ is ($fb->discard_changes->read_count, 21, 'Update ran only once on discard-join
 is ($fc->discard_changes->read_count, 30, 'Update did not touch outlier');
 
 # make the multi-join stick
-my $fks_multi = $fks->search({ 'fourkeys_to_twokeys.pilot_sequence' => { '!=' => 666 } });
+my $fks_multi = $fks->search(
+  { 'fourkeys_to_twokeys.pilot_sequence' => { '!=' => 666 } },
+  { order_by => [ $fks->result_source->primary_columns ] },
+);
 $schema->is_executed_sql_bind( sub {
   $fks_multi->update ({ read_count => \ 'read_count + 1' })
 }, [
@@ -85,6 +93,7 @@ $schema->is_executed_sql_bind( sub {
         ON fourkeys_to_twokeys.f_bar = me.bar AND fourkeys_to_twokeys.f_foo = me.foo AND fourkeys_to_twokeys.f_goodbye = me.goodbye AND fourkeys_to_twokeys.f_hello = me.hello
       WHERE ( bar = ? OR bar = ? ) AND ( foo = ? OR foo = ? ) AND fourkeys_to_twokeys.pilot_sequence != ? AND ( goodbye = ? OR goodbye = ? ) AND ( hello = ? OR hello = ? ) AND sensors != ?
       GROUP BY me.foo, me.bar, me.hello, me.goodbye
+      ORDER BY foo, bar, hello, goodbye
     ',
     (1, 2) x 2,
     666,
@@ -118,6 +127,7 @@ $schema->is_executed_sql_bind( sub {
         ON fourkeys_to_twokeys.f_bar = me.bar AND fourkeys_to_twokeys.f_foo = me.foo AND fourkeys_to_twokeys.f_goodbye = me.goodbye AND fourkeys_to_twokeys.f_hello = me.hello
       WHERE "blah" = "bleh" AND ( bar = ? OR bar = ? ) AND ( foo = ? OR foo = ? ) AND fourkeys_to_twokeys.pilot_sequence != ? AND ( goodbye = ? OR goodbye = ? ) AND ( hello = ? OR hello = ? ) AND sensors != ?
       GROUP BY me.foo, me.bar, me.hello, me.goodbye
+      ORDER BY foo, bar, hello, goodbye
     ',
     (1, 2) x 2,
     666,
@@ -147,6 +157,7 @@ $schema->is_executed_sql_bind( sub {
             AND fourkeys_to_twokeys.f_goodbye = me.goodbye
             AND fourkeys_to_twokeys.f_hello = me.hello
         WHERE ( bar = ? OR bar = ? ) AND ( foo = ? OR foo = ? ) AND fourkeys_to_twokeys.pilot_sequence != ? AND ( goodbye = ? OR goodbye = ? ) AND ( hello = ? OR hello = ? ) AND sensors != ?
+        ORDER BY foo, bar, hello, goodbye
       )
     )
   ',