use Test::More;
use Test::Exception;
+use Test::Warn;
use lib qw(t/lib);
use DBICTest;
+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();
# test mixed binds with literal sql/bind
$rs->populate([ map { +{
- url => \[ '? || ?', [ {} => 'cpan.org_' ], [ undef, $_ ] ],
+ url => \[ '? || ?', [ {} => 'cpan.org_' ], $_ ],
title => "The 'best of' cpan",
} } (1 .. 5) ]);
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 => 'foo3',
},
]);
-} qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice';
+} qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice fails PK insert';
is($rs->count, 0, 'populate is atomic');
]);
} 'literal+bind with semantically identical attrs works after normalization';
-# 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');
-
-lives_ok {
- $rs->populate([
- {
- name => 'supplied before stringifying object',
- },
- {
- name => $fn,
- }
- ]);
-} 'stringifying objects pass through';
-
-# ... and vice-versa.
-
-lives_ok {
- $rs->populate([
- {
- name => $fn2,
- },
- {
- name => 'supplied after stringifying object',
- },
- ]);
-} 'stringifying objects pass through';
-
-for (
- $fn,
- $fn2,
- 'supplied after stringifying object',
- 'supplied before stringifying object'
-) {
- my $row = $rs->find ({name => $_});
- ok ($row, "Stringification test row '$_' properly inserted");
-}
-
-$rs->delete;
-
-# test stringification with ->create rather than Storage::insert_bulk as well
-
-lives_ok {
- my @dummy = $rs->populate([
- {
- name => 'supplied before stringifying object',
- },
- {
- name => $fn,
- }
- ]);
-} 'stringifying objects pass through';
+# 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"
+ );
+ }
-# ... and vice-versa.
+ ok (
+ ($preimage eq nfreeze( [$fn, $fn2, $rank, $args] )),
+ 'Arguments fed to populate()/create() unchanged'
+ );
-lives_ok {
- my @dummy = $rs->populate([
- {
- name => $fn2,
- },
- {
- name => 'supplied after stringifying object',
- },
- ]);
-} 'stringifying objects pass through';
-
-for (
- $fn,
- $fn2,
- 'supplied after stringifying object',
- 'supplied before stringifying object'
-) {
- my $row = $rs->find ({name => $_});
- ok ($row, "Stringification test row '$_' properly inserted");
-}
+ $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 2
+], 'Data integrity warnings as planned';
lives_ok {
$schema->resultset('TwoKeys')->populate([{