t/101populate_rs.t

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