X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F100populate.t;h=27eb3effcd73a8c2d4f48b8ca1d4107d60af03fe;hb=3705e3b2801ea6a8f770b6f0c528b119bea92fe9;hp=abd70c8cc38efc3402a788640b4e265cf0d96b04;hpb=574d7df6e52ed1bdb9278acfd0960910929c6078;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/100populate.t b/t/100populate.t
index abd70c8..27eb3ef 100644
--- a/t/100populate.t
+++ b/t/100populate.t
@@ -3,10 +3,14 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 use lib qw(t/lib);
 use DBICTest;
-
-plan tests => 24;
+use DBIx::Class::_Util 'sigwarn_silencer';
+use Path::Class::File ();
+use Math::BigInt;
+use List::Util qw/shuffle/;
+use Storable qw/nfreeze dclone/;
 
 my $schema = DBICTest->init_schema();
 
@@ -19,10 +23,10 @@ my $schema = DBICTest->init_schema();
 #   [ 10000, "ntn" ],
 
 my $start_id = 'populateXaaaaaa';
-my $rows = 10;
+my $rows = 10_000;
 my $offset = 3;
 
-$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } ( 1 .. $rows ) ] );
+$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } shuffle ( 1 .. $rows ) ] );
 is (
     $schema->resultset ('Artist')->search ({ name => { -like => 'populateX%' } })->count,
     $rows,
@@ -45,7 +49,7 @@ throws_ok ( sub {
       }
     } ('Huey', 'Dewey', $ex_title, 'Louie')
   ])
-}, qr/columns .+ are not unique for populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
+}, qr/\Qexecute_for_fetch() aborted with '\E.+ at populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
 
 ## make sure populate honors fields/orders in list context
 ## schema order
@@ -116,19 +120,329 @@ is($link7->id, 7, 'Link 7 id');
 is($link7->url, undef, 'Link 7 url');
 is($link7->title, 'gtitle', 'Link 7 title');
 
-# test _execute_array_empty (insert_bulk with all literal sql)
-my $rs = $schema->resultset('Artist');
-$rs->delete;
-$rs->populate([
+# populate with literals
+{
+  my $rs = $schema->resultset('Link');
+  $rs->delete;
+
+  # test insert_bulk with all literal sql (no binds)
+
+  $rs->populate([
     (+{
-        name => \"'DT'",
-        rank => \500,
-        charfield => \"'mtfnpy'",
+        url => \"'cpan.org'",
+        title => \"'The ''best of'' cpan'",
     }) x 5
-]);
+  ]);
+
+  is((grep {
+    $_->url eq 'cpan.org' &&
+    $_->title eq "The 'best of' cpan",
+  } $rs->all), 5, 'populate with all literal SQL');
+
+  $rs->delete;
+
+  # test mixed binds with literal sql
+
+  $rs->populate([
+    (+{
+        url => \"'cpan.org'",
+        title => "The 'best of' cpan",
+    }) x 5
+  ]);
+
+  is((grep {
+    $_->url eq 'cpan.org' &&
+    $_->title eq "The 'best of' cpan",
+  } $rs->all), 5, 'populate with all literal SQL');
+
+  $rs->delete;
+}
+
+# populate with literal+bind
+{
+  my $rs = $schema->resultset('Link');
+  $rs->delete;
+
+  # test insert_bulk with all literal/bind sql
+  $rs->populate([
+    (+{
+        url => \['?', [ {} => 'cpan.org' ] ],
+        title => \['?', [ {} => "The 'best of' cpan" ] ],
+    }) x 5
+  ]);
+
+  is((grep {
+    $_->url eq 'cpan.org' &&
+    $_->title eq "The 'best of' cpan",
+  } $rs->all), 5, 'populate with all literal/bind');
+
+  $rs->delete;
+
+  # test insert_bulk with mix literal and literal/bind
+  $rs->populate([
+    (+{
+        url => \"'cpan.org'",
+        title => \['?', [ {} => "The 'best of' cpan" ] ],
+    }) x 5
+  ]);
+
+  is((grep {
+    $_->url eq 'cpan.org' &&
+    $_->title eq "The 'best of' cpan",
+  } $rs->all), 5, 'populate with all literal/bind SQL');
+
+  $rs->delete;
+
+  # test mixed binds with literal sql/bind
+
+  $rs->populate([ map { +{
+    url => \[ '? || ?', [ {} => 'cpan.org_' ], $_ ],
+    title => "The 'best of' cpan",
+  } } (1 .. 5) ]);
+
+  for (1 .. 5) {
+    ok($rs->find({ url => "cpan.org_$_" }), "Row $_ correctly created with dynamic literal/bind populate" );
+  }
+
+  $rs->delete;
+}
+
+my $rs = $schema->resultset('Artist');
+$rs->delete;
+throws_ok {
+    # this warning is correct, but we are not testing it here
+    # what we are after is the correct exception when an int
+    # fails to coerce into a sqlite rownum
+    local $SIG{__WARN__} = sigwarn_silencer( qr/datatype mismatch.+ foo as integer/ );
+
+    $rs->populate([
+        {
+            artistid => 1,
+            name => 'foo1',
+        },
+        {
+            artistid => 'foo', # this dies
+            name => 'foo2',
+        },
+        {
+            artistid => 3,
+            name => 'foo3',
+        },
+    ]);
+} qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice fails PK insert';
+
+is($rs->count, 0, 'populate is atomic');
+
+# Trying to use a column marked as a bind in the first slice with literal sql in
+# a later slice should throw.
+
+throws_ok {
+  $rs->populate([
+    {
+      artistid => 1,
+      name => \"'foo'",
+    },
+    {
+      artistid => \2,
+      name => \"'foo'",
+    }
+  ]);
+} qr/Literal SQL found where a plain bind value is expected/, 'literal sql where bind expected throws';
+
+# ... and vice-versa.
+
+throws_ok {
+  $rs->populate([
+    {
+      artistid => \1,
+      name => \"'foo'",
+    },
+    {
+      artistid => 2,
+      name => \"'foo'",
+    }
+  ]);
+} qr/\QIncorrect value (expecting SCALAR-ref/, 'bind where literal sql expected throws';
+
+throws_ok {
+  $rs->populate([
+    {
+      artistid => 1,
+      name => \"'foo'",
+    },
+    {
+      artistid => 2,
+      name => \"'bar'",
+    }
+  ]);
+} qr/Inconsistent literal SQL value/, 'literal sql must be the same in all slices';
+
+throws_ok {
+  $rs->populate([
+    {
+      artistid => 1,
+      name => \['?', [ {} => 'foo' ] ],
+    },
+    {
+      artistid => 2,
+      name => \"'bar'",
+    }
+  ]);
+} qr/\QIncorrect value (expecting ARRAYREF-ref/, 'literal where literal+bind expected throws';
+
+throws_ok {
+  $rs->populate([
+    {
+      artistid => 1,
+      name => \['?', [ { sqlt_datatype => 'foooo' } => 'foo' ] ],
+    },
+    {
+      artistid => 2,
+      name => \['?', [ {} => 'foo' ] ],
+    }
+  ]);
+} qr/\QDiffering bind attributes on literal\/bind values not supported for column 'name'/, 'literal+bind with differing attrs throws';
+
+lives_ok {
+  $rs->populate([
+    {
+      artistid => 1,
+      name => \['?', [ undef, 'foo' ] ],
+    },
+    {
+      artistid => 2,
+      name => \['?', [ {} => 'bar' ] ],
+    }
+  ]);
+} 'literal+bind with semantically identical attrs works after normalization';
+
+# test all kinds of population with stringified objects
+warnings_like {
+  local $ENV{DBIC_RT79576_NOWARN};
+
+  my $rs = $schema->resultset('Artist')->search({}, { columns => [qw(name rank)], order_by => 'artistid' });
+
+  # the stringification has nothing to do with the artist name
+  # this is solely for testing consistency
+  my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
+  my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
+  my $rank = Math::BigInt->new(42);
+
+  my $args = {
+    'stringifying objects after regular values' => [ map
+      { { name => $_, rank => $rank } }
+      (
+        'supplied before stringifying objects',
+        'supplied before stringifying objects 2',
+        $fn,
+        $fn2,
+      )
+    ],
+    'stringifying objects before regular values' => [ map
+      { { name => $_, rank => $rank } }
+      (
+        $fn,
+        $fn2,
+        'supplied after stringifying objects',
+        'supplied after stringifying objects 2',
+      )
+    ],
+    'stringifying objects between regular values' => [ map
+      { { name => $_, rank => $rank } }
+      (
+        'supplied before stringifying objects',
+        $fn,
+        $fn2,
+        'supplied after stringifying objects',
+      )
+    ],
+    'stringifying objects around regular values' => [ map
+      { { name => $_, rank => $rank } }
+      (
+        $fn,
+        'supplied between stringifying objects',
+        $fn2,
+      )
+    ],
+  };
+
+  local $Storable::canonical = 1;
+  my $preimage = nfreeze([$fn, $fn2, $rank, $args]);
+
+  for my $tst (keys %$args) {
+
+    # test void ctx
+    $rs->delete;
+    $rs->populate($args->{$tst});
+    is_deeply(
+      $rs->all_hri,
+      $args->{$tst},
+      "Populate() $tst in void context"
+    );
+
+    # test non-void ctx
+    $rs->delete;
+    my $dummy = $rs->populate($args->{$tst});
+    is_deeply(
+      $rs->all_hri,
+      $args->{$tst},
+      "Populate() $tst in non-void context"
+    );
+
+    # test create() as we have everything set up already
+    $rs->delete;
+    $rs->create($_) for @{$args->{$tst}};
+
+    is_deeply(
+      $rs->all_hri,
+      $args->{$tst},
+      "Create() $tst"
+    );
+  }
+
+  ok (
+    ($preimage eq nfreeze( [$fn, $fn2, $rank, $args] )),
+    'Arguments fed to populate()/create() unchanged'
+  );
+
+  $rs->delete;
+} [
+  # warning to be removed around Apr 1st 2015
+  # smokers start failing a month before that
+  (
+    ( DBICTest::RunMode->is_author and ( time() > 1427846400 ) )
+      or
+    ( DBICTest::RunMode->is_smoker and ( time() > 1425168000 ) )
+  )
+    ? ()
+    # one unique for populate() and create() each
+    : (qr/\QPOSSIBLE *PAST* DATA CORRUPTION detected \E.+\QTrigger condition encountered at @{[ __FILE__ ]} line\E \d/) x 3
+], 'Data integrity warnings as planned';
+
+lives_ok {
+   $schema->resultset('TwoKeys')->populate([{
+      artist => 1,
+      cd     => 5,
+      fourkeys_to_twokeys => [{
+            f_foo => 1,
+            f_bar => 1,
+            f_hello => 1,
+            f_goodbye => 1,
+            autopilot => 'a',
+      },{
+            f_foo => 2,
+            f_bar => 2,
+            f_hello => 2,
+            f_goodbye => 2,
+            autopilot => 'b',
+      }]
+   }])
+} 'multicol-PK has_many populate works';
+
+lives_ok ( sub {
+  $schema->populate('CD', [
+    {cdid => 10001, artist => $artist->id, title => 'Pretty Much Empty', year => 2011, tracks => []},
+  ])
+}, 'empty has_many relationship accepted by populate');
 
-is((grep {
-  $_->name eq 'DT' &&
-  $_->rank == 500  &&
-  $_->charfield eq 'mtfnpy'
-} $rs->all), 5, 'populate with all literal SQL');
+done_testing;