t/101populate_rs.t

   1 ## ----------------------------------------------------------------------------
   2 ## Tests for the $resultset->populate method.
   3 ##
   4 ## GOALS:  We need to test the method for both void and array context for all
   5 ## the following relationship types: belongs_to, has_many.  Additionally we
   6 ## need to test each of those for both specified PK's and autogenerated PK's
   7 ##
   8 ## Also need to test some stuff that should generate errors.
   9 ## ----------------------------------------------------------------------------
  10
  11 use strict;
  12 use warnings;
  13
  14 use Test::More;
  15 use Test::Warn;
  16 use Test::Exception;
  17 use lib qw(t/lib);
  18 use DBICTest;
  19
  20
  21 ## ----------------------------------------------------------------------------
  22 ## Get a Schema and some ResultSets we can play with.
  23 ## ----------------------------------------------------------------------------
  24
  25 my $schema  = DBICTest->init_schema();
  26 my $art_rs  = $schema->resultset('Artist');
  27 my $cd_rs  = $schema->resultset('CD');
  28
  29 my $restricted_art_rs  = $art_rs->search({ -and => [ rank => 42, charfield => { '=', \['(SELECT MAX(artistid) FROM artist) + ?', 6] } ] });
  30
  31 ok( $schema, 'Got a Schema object');
  32 ok( $art_rs, 'Got Good Artist Resultset');
  33 ok( $cd_rs, 'Got Good CD Resultset');
  34
  35
  36 ## ----------------------------------------------------------------------------
  37 ## Schema populate Tests
  38 ## ----------------------------------------------------------------------------
  39
  40 SCHEMA_POPULATE1: {
  41
  42   # throw a monkey wrench
  43   my $post_jnap_monkeywrench = $schema->resultset('Artist')->find(1)->update({ name => undef });
  44
  45   warnings_exist { $schema->populate('Artist', [
  46
  47     [qw/name cds/],
  48     ["001First Artist", [
  49       {title=>"001Title1", year=>2000},
  50       {title=>"001Title2", year=>2001},
  51       {title=>"001Title3", year=>2002},
  52     ]],
  53     ["002Second Artist", []],
  54     ["003Third Artist", [
  55       {title=>"003Title1", year=>2005},
  56     ]],
  57     [undef, [
  58       {title=>"004Title1", year=>2010}
  59     ]],
  60   ]) } qr/\QFast-path populate() of non-uniquely identifiable rows with related data is not possible/;
  61
  62   isa_ok $schema, 'DBIx::Class::Schema';
  63
  64   my ( $preexisting_undef, $artist1, $artist2, $artist3, $undef ) = $schema->resultset('Artist')->search({
  65     name=>["001First Artist","002Second Artist","003Third Artist", undef]},
  66     {order_by => { -asc => 'artistid' }})->all;
  67
  68   isa_ok  $artist1, 'DBICTest::Artist';
  69   isa_ok  $artist2, 'DBICTest::Artist';
  70   isa_ok  $artist3, 'DBICTest::Artist';
  71   isa_ok  $undef, 'DBICTest::Artist';
  72
  73   ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001";
  74   ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002";
  75   ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003";
  76   ok !defined $undef->name, "Got Expected Artist Name for Artist004";
  77
  78   ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1";
  79   ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2";
  80   ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3";
  81   ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4";
  82
  83   $post_jnap_monkeywrench->delete;
  84
  85   ARTIST1CDS: {
  86
  87     my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'});
  88
  89     isa_ok $cd1, 'DBICTest::CD';
  90     isa_ok $cd2, 'DBICTest::CD';
  91     isa_ok $cd3, 'DBICTest::CD';
  92
  93     ok $cd1->year == 2000;
  94     ok $cd2->year == 2001;
  95     ok $cd3->year == 2002;
  96
  97     ok $cd1->title eq '001Title1';
  98     ok $cd2->title eq '001Title2';
  99     ok $cd3->title eq '001Title3';
 100   }
 101
 102   ARTIST3CDS: {
 103
 104     my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'});
 105
 106     isa_ok $cd1, 'DBICTest::CD';
 107
 108     ok $cd1->year == 2005;
 109     ok $cd1->title eq '003Title1';
 110   }
 111
 112   ARTIST4CDS: {
 113
 114     my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'});
 115
 116     isa_ok $cd1, 'DBICTest::CD';
 117
 118     ok $cd1->year == 2010;
 119     ok $cd1->title eq '004Title1';
 120   }
 121
 122   ## Need to do some cleanup so that later tests don't get borked
 123
 124   $undef->delete;
 125 }
 126
 127
 128 ## ----------------------------------------------------------------------------
 129 ## Array context tests
 130 ## ----------------------------------------------------------------------------
 131
 132 ARRAY_CONTEXT: {
 133
 134   ## These first set of tests are cake because array context just delegates
 135   ## all its processing to $resultset->create
 136
 137   HAS_MANY_NO_PKS: {
 138
 139     ## This first group of tests checks to make sure we can call populate
 140     ## with the parent having many children and let the keys be automatic
 141
 142     my $artists = [
 143       {
 144         name => 'Angsty-Whiny Girl',
 145         cds => [
 146           { title => 'My First CD', year => 2006 },
 147           { title => 'Yet More Tweeny-Pop crap', year => 2007 },
 148         ],
 149       },
 150       {
 151         name => 'Manufactured Crap',
 152       },
 153       {
 154         name => 'Like I Give a Damn',
 155         cds => [
 156           { title => 'My parents sold me to a record company' ,year => 2005 },
 157           { title => 'Why Am I So Ugly?', year => 2006 },
 158           { title => 'I Got Surgery and am now Popular', year => 2007 }
 159         ],
 160       },
 161       {
 162         name => 'Formerly Named',
 163         cds => [
 164           { title => 'One Hit Wonder', year => 2006 },
 165         ],
 166       },
 167     ];
 168
 169     ## Get the result row objects.
 170
 171     my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
 172
 173     ## Do we have the right object?
 174
 175     isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 176     isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 177     isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 178     isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 179
 180     ## Find the expected information?
 181
 182     ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object");
 183     ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object");
 184     ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object");
 185     ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object");
 186
 187     ## Create the expected children sub objects?
 188
 189     ok( $crap->cds->count == 0, "got Expected Number of Cds");
 190     ok( $girl->cds->count == 2, "got Expected Number of Cds");
 191     ok( $damn->cds->count == 3, "got Expected Number of Cds");
 192     ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 193
 194     ## Did the cds get expected information?
 195
 196     my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year'});
 197
 198     ok( $cd1->title eq "My First CD", "Got Expected CD Title");
 199     ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title");
 200   }
 201
 202   HAS_MANY_WITH_PKS: {
 203
 204     ## This group tests the ability to specify the PK in the parent and let
 205     ## DBIC transparently pass the PK down to the Child and also let's the
 206     ## child create any other needed PK's for itself.
 207
 208     my $aid    =  $art_rs->get_column('artistid')->max || 0;
 209
 210     my $first_aid = ++$aid;
 211
 212     my $artists = [
 213       {
 214         artistid => $first_aid,
 215         name => 'PK_Angsty-Whiny Girl',
 216         cds => [
 217           { artist => $first_aid, title => 'PK_My First CD', year => 2006 },
 218           { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 },
 219         ],
 220       },
 221       {
 222         artistid => ++$aid,
 223         name => 'PK_Manufactured Crap',
 224       },
 225       {
 226         artistid => ++$aid,
 227         name => 'PK_Like I Give a Damn',
 228         cds => [
 229           { title => 'PK_My parents sold me to a record company' ,year => 2005 },
 230           { title => 'PK_Why Am I So Ugly?', year => 2006 },
 231           { title => 'PK_I Got Surgery and am now Popular', year => 2007 }
 232         ],
 233       },
 234       {
 235         artistid => ++$aid,
 236         name => 'PK_Formerly Named',
 237         cds => [
 238           { title => 'PK_One Hit Wonder', year => 2006 },
 239         ],
 240       },
 241     ];
 242
 243     ## Get the result row objects.
 244
 245     my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
 246
 247     ## Do we have the right object?
 248
 249     isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 250     isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 251     isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 252     isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 253
 254     ## Find the expected information?
 255
 256     ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object");
 257     ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object");
 258     ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object");
 259     ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object");
 260     ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object");
 261
 262     ## Create the expected children sub objects?
 263
 264     ok( $crap->cds->count == 0, "got Expected Number of Cds");
 265     ok( $girl->cds->count == 2, "got Expected Number of Cds");
 266     ok( $damn->cds->count == 3, "got Expected Number of Cds");
 267     ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 268
 269     ## Did the cds get expected information?
 270
 271     my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 272
 273     ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title");
 274     ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 275   }
 276
 277   BELONGS_TO_NO_PKs: {
 278
 279     ## Test from a belongs_to perspective, should create artist first,
 280     ## then CD with artistid.  This test we let the system automatically
 281     ## create the PK's.  Chances are good you'll use it this way mostly.
 282
 283     my $cds = [
 284       {
 285         title => 'Some CD3',
 286         year => '1997',
 287         artist => { name => 'Fred BloggsC'},
 288       },
 289       {
 290         title => 'Some CD4',
 291         year => '1997',
 292         artist => { name => 'Fred BloggsD'},
 293       },
 294     ];
 295
 296     my ($cdA, $cdB) = $cd_rs->populate($cds);
 297
 298
 299     isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 300     isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 301     is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
 302
 303
 304     isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 305     isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 306     is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
 307   }
 308
 309   BELONGS_TO_WITH_PKs: {
 310
 311     ## Test from a belongs_to perspective, should create artist first,
 312     ## then CD with artistid.  This time we try setting the PK's
 313
 314     my $aid  = $art_rs->get_column('artistid')->max || 0;
 315
 316     my $cds = [
 317       {
 318         title => 'Some CD3',
 319         year => '1997',
 320         artist => { artistid=> ++$aid, name => 'Fred BloggsE'},
 321       },
 322       {
 323         title => 'Some CD4',
 324         year => '1997',
 325         artist => { artistid=> ++$aid, name => 'Fred BloggsF'},
 326       },
 327     ];
 328
 329     my ($cdA, $cdB) = $cd_rs->populate($cds);
 330
 331     isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 332     isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 333     is($cdA->artist->name, 'Fred BloggsE', 'Set Artist to FredE');
 334
 335     isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 336     isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 337     is($cdB->artist->name, 'Fred BloggsF', 'Set Artist to FredF');
 338     ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
 339   }
 340
 341   WITH_COND_FROM_RS: {
 342
 343     my ($more_crap) = $restricted_art_rs->populate([
 344       {
 345         name => 'More Manufactured Crap',
 346       },
 347     ]);
 348
 349     ## Did it use the condition in the resultset?
 350     $more_crap->discard_changes;
 351     cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
 352     cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object");
 353   }
 354 }
 355
 356
 357 ## ----------------------------------------------------------------------------
 358 ## Void context tests
 359 ## ----------------------------------------------------------------------------
 360
 361 VOID_CONTEXT: {
 362
 363   ## All these tests check the ability to use populate without asking for
 364   ## any returned resultsets.  This uses bulk_insert as much as possible
 365   ## in order to increase speed.
 366
 367   HAS_MANY_WITH_PKS: {
 368
 369     ## This first group of tests checks to make sure we can call populate
 370     ## with the parent having many children and the parent PK is set
 371
 372     my $aid = $art_rs->get_column('artistid')->max || 0;
 373
 374     my $first_aid = ++$aid;
 375
 376     my $artists = [
 377       {
 378         artistid => $first_aid,
 379         name => 'VOID_PK_Angsty-Whiny Girl',
 380         cds => [
 381           { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 },
 382           { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 },
 383         ],
 384       },
 385       {
 386         artistid => ++$aid,
 387         name => 'VOID_PK_Manufactured Crap',
 388       },
 389       {
 390         artistid => ++$aid,
 391         name => 'VOID_PK_Like I Give a Damn',
 392         cds => [
 393           { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 },
 394           { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 },
 395           { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 }
 396         ],
 397       },
 398       {
 399         artistid => ++$aid,
 400         name => 'VOID_PK_Formerly Named',
 401         cds => [
 402           { title => 'VOID_PK_One Hit Wonder', year => 2006 },
 403         ],
 404       },
 405       {
 406         artistid => ++$aid,
 407         name => undef,
 408         cds => [
 409           { title => 'VOID_PK_Zundef test', year => 2006 },
 410         ],
 411       },
 412     ];
 413
 414     ## Get the result row objects.
 415
 416     $art_rs->populate($artists);
 417
 418     my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search(
 419
 420       {name=>[ map { $_->{name} } @$artists]},
 421       {order_by=>'name ASC'},
 422     );
 423
 424     ## Do we have the right object?
 425
 426     isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 427     isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 428     isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 429     isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 430     isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'");
 431
 432     ## Find the expected information?
 433
 434     ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object");
 435     ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object");
 436     ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object");
 437     ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object");
 438     ok( !defined $undef->name, "Got Correct name 'is undef' for result object");
 439
 440     ## Create the expected children sub objects?
 441     ok( $crap->can('cds'), "Has cds relationship");
 442     ok( $girl->can('cds'), "Has cds relationship");
 443     ok( $damn->can('cds'), "Has cds relationship");
 444     ok( $formerly->can('cds'), "Has cds relationship");
 445     ok( $undef->can('cds'), "Has cds relationship");
 446
 447     ok( $crap->cds->count == 0, "got Expected Number of Cds");
 448     ok( $girl->cds->count == 2, "got Expected Number of Cds");
 449     ok( $damn->cds->count == 3, "got Expected Number of Cds");
 450     ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 451     ok( $undef->cds->count == 1, "got Expected Number of Cds");
 452
 453     ## Did the cds get expected information?
 454
 455     my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 456
 457     ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title");
 458     ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 459   }
 460
 461
 462   BELONGS_TO_WITH_PKs: {
 463
 464     ## Test from a belongs_to perspective, should create artist first,
 465     ## then CD with artistid.  This time we try setting the PK's
 466
 467     my $aid  = $art_rs->get_column('artistid')->max || 0;
 468
 469     my $cds = [
 470       {
 471         title => 'Some CD3B',
 472         year => '1997',
 473         artist => { artistid=> ++$aid, name => 'Fred BloggsCB'},
 474       },
 475       {
 476         title => 'Some CD4B',
 477         year => '1997',
 478         artist => { artistid=> ++$aid, name => 'Fred BloggsDB'},
 479       },
 480     ];
 481
 482     warnings_exist {
 483       $cd_rs->populate($cds)
 484     } qr/\QFast-path populate() of belongs_to relationship data is not possible/;
 485
 486     my ($cdA, $cdB) = $cd_rs->search(
 487       {title=>[sort map {$_->{title}} @$cds]},
 488       {order_by=>'title ASC'},
 489     );
 490
 491     isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 492     isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 493     is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB');
 494
 495     isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 496     isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 497     is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB');
 498     ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
 499   }
 500
 501   BELONGS_TO_NO_PKs: {
 502
 503     ## Test from a belongs_to perspective, should create artist first,
 504     ## then CD with artistid.
 505
 506     my $cds = [
 507       {
 508         title => 'Some CD3BB',
 509         year => '1997',
 510         artist => { name => 'Fred BloggsCBB'},
 511       },
 512       {
 513         title => 'Some CD4BB',
 514         year => '1997',
 515         artist => { name => 'Fred BloggsDBB'},
 516       },
 517       {
 518         title => 'Some CD5BB',
 519         year => '1997',
 520         artist => { name => undef},
 521       },
 522     ];
 523
 524     warnings_exist {
 525       $cd_rs->populate($cds);
 526     } qr/\QFast-path populate() of belongs_to relationship data is not possible/;
 527
 528     my ($cdA, $cdB, $cdC) = $cd_rs->search(
 529       {title=>[sort map {$_->{title}} @$cds]},
 530       {order_by=>'title ASC'},
 531     );
 532
 533     isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 534     isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 535     is($cdA->title, 'Some CD3BB', 'Found Expected title');
 536     is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB');
 537
 538     isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 539     isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 540     is($cdB->title, 'Some CD4BB', 'Found Expected title');
 541     is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB');
 542
 543     isa_ok($cdC, 'DBICTest::CD', 'Created CD');
 544     isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist');
 545     is($cdC->title, 'Some CD5BB', 'Found Expected title');
 546     is( $cdC->artist->name, undef, 'Set Artist to something undefined');
 547   }
 548
 549
 550   HAS_MANY_NO_PKS: {
 551
 552     ## This first group of tests checks to make sure we can call populate
 553     ## with the parent having many children and let the keys be automatic
 554
 555     my $artists = [
 556       {
 557         name => 'VOID_Angsty-Whiny Girl',
 558         cds => [
 559           { title => 'VOID_My First CD', year => 2006 },
 560           { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 },
 561         ],
 562       },
 563       {
 564         name => 'VOID_Manufactured Crap',
 565       },
 566       {
 567         name => 'VOID_Like I Give a Damn',
 568         cds => [
 569           { title => 'VOID_My parents sold me to a record company' ,year => 2005 },
 570           { title => 'VOID_Why Am I So Ugly?', year => 2006 },
 571           { title => 'VOID_I Got Surgery and am now Popular', year => 2007 }
 572         ],
 573       },
 574       {
 575         name => 'VOID_Formerly Named',
 576         cds => [
 577           { title => 'VOID_One Hit Wonder', year => 2006 },
 578         ],
 579       },
 580     ];
 581
 582     ## Get the result row objects.
 583
 584     $art_rs->populate($artists);
 585
 586     my ($girl, $formerly, $damn, $crap) = $art_rs->search(
 587       {name=>[sort map {$_->{name}} @$artists]},
 588       {order_by=>'name ASC'},
 589     );
 590
 591     ## Do we have the right object?
 592
 593     isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 594     isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 595     isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 596     isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 597
 598     ## Find the expected information?
 599
 600     ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object");
 601     ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object");
 602     ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object");
 603     ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object");
 604
 605     ## Create the expected children sub objects?
 606     ok( $crap->can('cds'), "Has cds relationship");
 607     ok( $girl->can('cds'), "Has cds relationship");
 608     ok( $damn->can('cds'), "Has cds relationship");
 609     ok( $formerly->can('cds'), "Has cds relationship");
 610
 611     ok( $crap->cds->count == 0, "got Expected Number of Cds");
 612     ok( $girl->cds->count == 2, "got Expected Number of Cds");
 613     ok( $damn->cds->count == 3, "got Expected Number of Cds");
 614     ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 615
 616     ## Did the cds get expected information?
 617
 618     my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 619
 620     ok($cd1, "Got a got CD");
 621     ok($cd2, "Got a got CD");
 622     ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title");
 623     ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 624   }
 625
 626   WITH_COND_FROM_RS: {
 627
 628     $restricted_art_rs->populate([
 629       {
 630         name => 'VOID More Manufactured Crap',
 631       },
 632     ]);
 633
 634     my $more_crap = $art_rs->search({
 635       name => 'VOID More Manufactured Crap'
 636     })->first;
 637
 638     ## Did it use the condition in the resultset?
 639     $more_crap->discard_changes;
 640     cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
 641     cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object");
 642   }
 643 }
 644
 645 ARRAYREF_OF_ARRAYREF_STYLE: {
 646   $art_rs->populate([
 647     [qw/artistid name/],
 648     [1000, 'A Formally Unknown Singer'],
 649     [1001, 'A singer that jumped the shark two albums ago'],
 650     [1002, 'An actually cool singer.'],
 651   ]);
 652
 653   ok my $unknown = $art_rs->find(1000), "got Unknown";
 654   ok my $jumped = $art_rs->find(1001), "got Jumped";
 655   ok my $cool = $art_rs->find(1002), "got Cool";
 656
 657   is $unknown->name, 'A Formally Unknown Singer', 'Correct Name';
 658   is $jumped->name, 'A singer that jumped the shark two albums ago', 'Correct Name';
 659   is $cool->name, 'An actually cool singer.', 'Correct Name';
 660
 661   my ($cooler, $lamer) = $restricted_art_rs->populate([
 662     [qw/artistid name/],
 663     [1003, 'Cooler'],
 664     [1004, 'Lamer'],
 665   ]);
 666
 667   is $cooler->name, 'Cooler', 'Correct Name';
 668   is $lamer->name, 'Lamer', 'Correct Name';
 669
 670   for ($cooler, $lamer) {
 671     $_->discard_changes;
 672     cmp_ok( $_->rank, '==', 42, "Got Correct rank for result object");
 673     cmp_ok( $_->charfield, '==', $_->id + 5, "Got Correct charfield for result object");
 674   }
 675
 676   ARRAY_CONTEXT_WITH_COND_FROM_RS: {
 677
 678     my ($mega_lamer) = $restricted_art_rs->populate([
 679       {
 680         name => 'Mega Lamer',
 681       },
 682     ]);
 683
 684     ## Did it use the condition in the resultset?
 685     $mega_lamer->discard_changes;
 686     cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
 687     cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object");
 688   }
 689
 690   VOID_CONTEXT_WITH_COND_FROM_RS: {
 691
 692     $restricted_art_rs->populate([
 693       {
 694         name => 'VOID Mega Lamer',
 695       },
 696     ]);
 697
 698     my $mega_lamer = $art_rs->search({
 699       name => 'VOID Mega Lamer'
 700     })->first;
 701
 702     ## Did it use the condition in the resultset?
 703     cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
 704     cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object");
 705   }
 706 }
 707
 708 EMPTY_POPULATE: {
 709   foreach(
 710     [ empty         => [] ],
 711     [ columns_only  => [ [qw(name rank charfield)] ] ],
 712   ) {
 713     my ($desc, $arg) = @{$_};
 714
 715     $schema->is_executed_sql_bind( sub {
 716
 717       my $rs = $art_rs;
 718       lives_ok { $rs->populate($arg); 1 } "$desc populate in void context lives";
 719
 720       my @r = $art_rs->populate($arg);
 721       is_deeply( \@r, [], "$desc populate in list context returns empty list" );
 722
 723       my $r = $art_rs->populate($arg);
 724       is( $r, undef, "$desc populate in scalar context returns undef" );
 725
 726     }, [], "$desc populate executed no statements" );
 727   }
 728 }
 729
 730 done_testing;