Cleanup code in _dbh_columns_info_for, add stresstest var to smoke it
[dbsrgits/DBIx-Class.git] / t / 72pg.t
index f9f61c4..5f00ff9 100644 (file)
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -4,9 +4,15 @@ use warnings;
 use Test::More;
 use Test::Exception;
 use Sub::Name;
+use Config;
+use DBIx::Class::Optional::Dependencies ();
 use lib qw(t/lib);
 use DBICTest;
+use SQL::Abstract 'is_literal_value';
+use DBIx::Class::_Util 'is_exception';
 
+plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_pg')
+  unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_pg');
 
 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
 
@@ -88,14 +94,12 @@ DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_class
 
 # check if we indeed do support stuff
 my $test_server_supports_insert_returning = do {
-  my $v = DBICTest::Schema->connect($dsn, $user, $pass)
-                   ->storage
-                    ->_get_dbh
-                     ->get_info(18);
-  $v =~ /^(\d+)\.(\d+)/
-    or die "Unparseable Pg server version: $v\n";
-
-  ( sprintf ('%d.%d', $1, $2) >= 8.2 ) ? 1 : 0;
+
+  my $si = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info;
+  die "Unparseable Pg server version: $si->{dbms_version}\n"
+    unless $si->{normalized_dbms_version};
+
+  $si->{normalized_dbms_version} < 8.002 ? 0 : 1;
 };
 is (
   DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
@@ -109,9 +113,10 @@ for my $use_insert_returning ($test_server_supports_insert_returning
   : (0)
 ) {
 
-  no warnings qw/once/;
+  no warnings qw/once redefine/;
+  my $old_connection = DBICTest::Schema->can('connection');
   local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
-    my $s = shift->next::method (@_);
+    my $s = shift->$old_connection(@_);
     $s->storage->_use_insert_returning ($use_insert_returning);
     $s;
   };
@@ -144,6 +149,16 @@ for my $use_insert_returning ($test_server_supports_insert_returning
   run_apk_tests($schema); #< older set of auto-pk tests
   run_extended_apk_tests($schema); #< new extended set of auto-pk tests
 
+
+######## test the pg-specific syntax from https://rt.cpan.org/Ticket/Display.html?id=99503
+  lives_ok {
+    is(
+      $schema->resultset('Artist')->search({ artistid => { -in => \ '(select 4) union (select 5)' } })->count,
+      2,
+      'Two expected artists found on subselect union within IN',
+    );
+  };
+
 ### type_info tests
 
   my $test_type_info = {
@@ -181,14 +196,19 @@ for my $use_insert_returning ($test_server_supports_insert_returning
 
   my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist');
   my $artistid_defval = delete $type_info->{artistid}->{default_value};
-  like($artistid_defval,
-       qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
-       'columns_info_for - sequence matches Pg get_autoinc_seq expectations');
-  is_deeply($type_info, $test_type_info,
-            'columns_info_for - column data types');
-
 
+  # The curor info is too radically different from what is in the column_info
+  # call - just punt it (DBD::SQLite tests the codepath plenty enough)
+  unless (DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE) {
+    like(
+      $artistid_defval,
+      qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
+      'columns_info_for - sequence matches Pg get_autoinc_seq expectations'
+    );
 
+    is_deeply($type_info, $test_type_info,
+            'columns_info_for - column data types');
+  }
 
 ####### Array tests
 
@@ -198,7 +218,7 @@ for my $use_insert_returning ($test_server_supports_insert_returning
 
     use strict;
     use warnings;
-    use base 'DBIx::Class::Core';
+    use base 'DBICTest::BaseResult';
 
     __PACKAGE__->table('dbic_t_schema.array_test');
     __PACKAGE__->add_columns(qw/id arrayfield/);
@@ -209,43 +229,99 @@ for my $use_insert_returning ($test_server_supports_insert_returning
   SKIP: {
     skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002;
 
+    my $arr_rs = $schema->resultset('ArrayTest');
+
     lives_ok {
-      $schema->resultset('ArrayTest')->create({
+      $arr_rs->create({
         arrayfield => [1, 2],
       });
     } 'inserting arrayref as pg array data';
 
     lives_ok {
-      $schema->resultset('ArrayTest')->update({
+      $arr_rs->update({
         arrayfield => [3, 4],
       });
     } 'updating arrayref as pg array data';
 
-    $schema->resultset('ArrayTest')->create({
+    $arr_rs->create({
       arrayfield => [5, 6],
     });
 
-    my $afield_rs = $schema->resultset('ArrayTest')->search({
-      arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ],   #Todo anything less ugly than this?
-    });
+    lives_ok {
+      $schema->populate('ArrayTest', [
+        [ qw/arrayfield/ ],
+        [ [0,0]          ],
+      ]);
+    } 'inserting arrayref using void ctx populate';
 
-    my $count;
+    # Search using arrays
     lives_ok {
-      $count = $afield_rs->count
-    } 'comparing arrayref to pg array data does not blow up';
-    is($count, 1, 'comparing arrayref to pg array data gives correct result');
+      is_deeply (
+        $arr_rs->search({ arrayfield => { -value => [3,4] } })->first->arrayfield,
+        [3,4],
+        'Array value matches'
+      );
+    } 'searching by arrayref';
+
+    lives_ok {
+      is_deeply (
+        $arr_rs->search({ arrayfield => { '=' => { -value => [3,4] }} })->first->arrayfield,
+        [3,4],
+        'Array value matches explicit equal'
+      );
+    } 'searching by arrayref (explicit equal sign)';
+
+    lives_ok {
+      is_deeply (
+        $arr_rs->search({ arrayfield => { '>' => { -value => [3,1] }} })->first->arrayfield,
+        [3,4],
+        'Array value matches greater than'
+      );
+    } 'searching by arrayref (greater than)';
 
-    TODO: {
-      local $TODO = 'No introspection of scalarref conditions :(';
-      my $row = $afield_rs->create({});
+    lives_ok {
+      is (
+        $arr_rs->search({ arrayfield => { '>' => { -value => [3,7] }} })->count,
+        1,
+        'Greater than search found [5,6]',
+      );
+    } 'searching by arrayref (greater than)';
+
+    # Find using arrays
+    lives_ok {
+      is_deeply (
+        $arr_rs->find({ arrayfield => { -value => [3,4] } })->arrayfield,
+        [3,4],
+        'Array value matches implicit equal'
+      );
+    } 'find by arrayref';
+
+    lives_ok {
+      is_deeply (
+        $arr_rs->find({ arrayfield => { '=' => { -value => [3,4] }} })->arrayfield,
+        [3,4],
+        'Array value matches explicit equal'
+      );
+    } 'find by arrayref (equal)';
+
+    # test inferred condition for creation
+    for my $cond (
+      { -value => [3,4] },
+      \[ '= ?' => [arrayfield => [3, 4]] ],
+    ) {
+      local $TODO = 'No introspection of complex literal conditions :('
+        if is_literal_value $cond;
+
+
+      my $arr_rs_cond = $arr_rs->search({ arrayfield => $cond });
+
+      my $row = $arr_rs_cond->create({});
       is_deeply ($row->arrayfield, [3,4], 'Array value taken from $rs condition');
       $row->discard_changes;
       is_deeply ($row->arrayfield, [3,4], 'Array value made it to storage');
     }
   }
 
-
-
 ########## Case check
 
   BEGIN {
@@ -280,14 +356,9 @@ my $cds = $artist->cds_unordered->search({
 lives_ok { $cds->update({ year => '2010' }) } 'Update on prefetched rs';
 
 ## Test SELECT ... FOR UPDATE
-
   SKIP: {
-      if(eval { require Sys::SigAction }) {
-          Sys::SigAction->import( 'set_sig_handler' );
-      }
-      else {
-        skip "Sys::SigAction is not available", 6;
-      }
+      skip "Your system does not support unsafe signals (d_sigaction) - unable to run deadlock test", 1
+        unless eval { $Config{d_sigaction} and require POSIX };
 
       my ($timed_out, $artist2);
 
@@ -326,15 +397,28 @@ lives_ok { $cds->update({ year => '2010' }) } 'Update on prefetched rs';
           is($artist->artistid, 1, "select returns artistid = 1");
 
           $timed_out = 0;
+
           eval {
-              my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
+              # can not use %SIG assignment directly - we need sigaction below
+              # localization to a block still works however
+              local $SIG{ALRM};
+
+              POSIX::sigaction( POSIX::SIGALRM() => POSIX::SigAction->new(
+                sub { die "DBICTestTimeout" },
+              ));
+
               alarm(2);
               $artist2 = $schema2->resultset('Artist')->find(1);
               $artist2->name('fooey');
               $artist2->update;
-              alarm(0);
           };
-          $timed_out = $@ =~ /DBICTestTimeout/;
+
+          alarm(0);
+
+          if (is_exception($@)) {
+            $timed_out = $@ =~ /DBICTestTimeout/
+              or die $@;
+          }
         });
 
         $t->{test_sub}->();
@@ -379,7 +463,7 @@ lives_ok { $cds->update({ year => '2010' }) } 'Update on prefetched rs';
   } 'with_deferred_fk_checks code survived';
 
   is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track',
-     'code in with_deferred_fk_checks worked'; 
+     'code in with_deferred_fk_checks worked';
 
   throws_ok {
     $schema->resultset('Track')->create({
@@ -393,7 +477,8 @@ done_testing;
 END {
     return unless $schema;
     drop_test_schema($schema);
-    eapk_drop_all( $schema)
+    eapk_drop_all($schema);
+    undef $schema;
 };
 
 
@@ -441,8 +526,7 @@ CREATE TABLE dbic_t_schema.track (
   position int,
   title varchar(255),
   last_updated_on date,
-  last_updated_at date,
-  small_dt date
+  last_updated_at date
 )
 EOS
 
@@ -517,12 +601,12 @@ sub drop_test_schema {
 
         for my $stat (
                       'DROP SCHEMA dbic_t_schema_5 CASCADE',
-                      'DROP SEQUENCE public.artist_artistid_seq',
+                      'DROP SEQUENCE public.artist_artistid_seq CASCADE',
                       'DROP SCHEMA dbic_t_schema_4 CASCADE',
                       'DROP SCHEMA dbic_t_schema CASCADE',
-                      'DROP SEQUENCE pkid1_seq',
-                      'DROP SEQUENCE pkid2_seq',
-                      'DROP SEQUENCE nonpkid_seq',
+                      'DROP SEQUENCE pkid1_seq CASCADE',
+                      'DROP SEQUENCE pkid2_seq CASCADE',
+                      'DROP SEQUENCE nonpkid_seq CASCADE',
                       'DROP SCHEMA dbic_t_schema_2 CASCADE',
                       'DROP SCHEMA dbic_t_schema_3 CASCADE',
                      ) {