is($links[0]->url, undef);
is($links[1]->url, 'url42');
-## make sure populate -> insert_bulk honors fields/orders in void context
+## make sure populate -> _insert_bulk honors fields/orders in void context
## schema order
$schema->populate('Link', [
[ qw/id url title/ ],
my $rs = $schema->resultset('Link');
$rs->delete;
- # test insert_bulk with all literal sql (no binds)
+ # test populate with all literal sql (no binds)
$rs->populate([
(+{
my $rs = $schema->resultset('Link');
$rs->delete;
- # test insert_bulk with all literal/bind sql
+ # test populate with all literal/bind sql
$rs->populate([
(+{
url => \['?', [ {} => 'cpan.org' ] ],
$rs->delete;
- # test insert_bulk with mix literal and literal/bind
+ # test populate with mix literal and literal/bind
$rs->populate([
(+{
url => \"'cpan.org'",
} 'literal+bind with semantically identical attrs works after normalization';
# test all kinds of population with stringified objects
+# or with empty sets
warnings_like {
local $ENV{DBIC_RT79576_NOWARN};
my $rank = Math::BigInt->new(42);
my $args = {
- 'stringifying objects after regular values' => [ map
- { { name => $_, rank => $rank } }
- (
+ 'stringifying objects after regular values' => { AoA => [
+ [qw( name rank )],
+ ( map { [ $_, $rank ] } (
'supplied before stringifying objects',
'supplied before stringifying objects 2',
$fn,
$fn2,
- )
- ],
- 'stringifying objects before regular values' => [ map
- { { name => $_, rank => $rank } }
- (
+ )),
+ ]},
+
+ 'stringifying objects before regular values' => { AoA => [
+ [qw( rank name )],
+ ( map { [ $rank, $_ ] } (
$fn,
$fn2,
'supplied after stringifying objects',
'supplied after stringifying objects 2',
- )
- ],
- 'stringifying objects between regular values' => [ map
- { { name => $_, rank => $rank } }
- (
+ )),
+ ]},
+
+ 'stringifying objects between regular values' => { AoA => [
+ [qw( name rank )],
+ ( map { [ $_, $rank ] } (
'supplied before stringifying objects',
$fn,
$fn2,
'supplied after stringifying objects',
- )
- ],
- 'stringifying objects around regular values' => [ map
- { { name => $_, rank => $rank } }
- (
+ ))
+ ]},
+
+ 'stringifying objects around regular values' => { AoA => [
+ [qw( rank name )],
+ ( map { [ $rank, $_ ] } (
$fn,
'supplied between stringifying objects',
$fn2,
- )
- ],
+ ))
+ ]},
+
+ 'single stringifying object' => { AoA => [
+ [qw( rank name )],
+ [ $rank, $fn ],
+ ]},
+
+ 'empty set' => { AoA => [
+ [qw( name rank )],
+ ]},
};
- local $Storable::canonical = 1;
- my $preimage = nfreeze([$fn, $fn2, $rank, $args]);
+ # generate the AoH equivalent based on the AoAs above
+ for my $bag (values %$args) {
+ $bag->{AoH} = [];
+ my @hdr = @{$bag->{AoA}[0]};
+ for my $v ( @{$bag->{AoA}}[1..$#{$bag->{AoA}}] ) {
+ push @{$bag->{AoH}}, my $h = {};
+ @{$h}{@hdr} = @$v;
+ }
+ }
- for my $tst (keys %$args) {
+ local $Storable::canonical = 1;
+ my $preimage = nfreeze($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"
- );
+ for my $tst (keys %$args) {
+ for my $type (qw(AoA AoH)) {
+
+ # test void ctx
+ $rs->delete;
+ $rs->populate($args->{$tst}{$type});
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst}{AoH},
+ "Populate() $tst in void context"
+ );
+
+ # test scalar ctx
+ $rs->delete;
+ my $dummy = $rs->populate($args->{$tst}{$type});
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst}{AoH},
+ "Populate() $tst in non-void context"
+ );
+
+ # test list ctx
+ $rs->delete;
+ my @dummy = $rs->populate($args->{$tst}{$type});
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst}{AoH},
+ "Populate() $tst in non-void context"
+ );
+ }
# test create() as we have everything set up already
$rs->delete;
- $rs->create($_) for @{$args->{$tst}};
+ $rs->create($_) for @{$args->{$tst}{AoH}};
is_deeply(
$rs->all_hri,
- $args->{$tst},
+ $args->{$tst}{AoH},
"Create() $tst"
);
}
ok (
- ($preimage eq nfreeze( [$fn, $fn2, $rank, $args] )),
+ ($preimage eq nfreeze($args)),
'Arguments fed to populate()/create() unchanged'
);
)
? ()
# one unique for populate() and create() each
- : (qr/\QPOSSIBLE *PAST* DATA CORRUPTION detected \E.+\QTrigger condition encountered at @{[ __FILE__ ]} line\E \d/) x 2
+ : (qr/\QPOSSIBLE *PAST* DATA CORRUPTION detected \E.+\QTrigger condition encountered at @{[ __FILE__ ]} line\E \d/) x 4
], 'Data integrity warnings as planned';
$schema->is_executed_sql_bind(