t/configure/032-data.t

   1 #!perl
   2 # Copyright (C) 2001-2005, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use lib qw( lib );
   9 use Test::More tests => 69;
  10
  11 =head1 NAME
  12
  13 t/configure/032-data.t - tests Parrot::Configure::Data
  14
  15 =head1 SYNOPSIS
  16
  17     prove t/configure/032-data.t
  18
  19 =head1 DESCRIPTION
  20
  21 Regressions tests for the L<Parrote::Configure::Data> class.
  22
  23 =cut
  24
  25 BEGIN { use Parrot::Configure::Data; }
  26
  27 can_ok(
  28     'Parrot::Configure::Data', qw(
  29         new
  30         get
  31         set
  32         keys
  33         dump
  34         clean
  35         settrigger
  36         gettriggers
  37         gettrigger
  38         deltrigger
  39         )
  40 );
  41
  42 {
  43     my $pcd = Parrot::Configure::Data->new;
  44
  45     isa_ok( $pcd, 'Parrot::Configure::Data' );
  46 }
  47
  48 # ->get() / ->set()
  49 {
  50     my $pcd = Parrot::Configure::Data->new;
  51
  52     is( $pcd->get('a'), undef, "->get() unset value returns undef in scalar context" );
  53     is( ( $pcd->get('a') ), undef, "->get() unset value returns undef in list context" );
  54
  55     my @values = $pcd->get(qw(a b c));
  56
  57     ok(
  58         eq_array( \@values, [ undef, undef, undef ] ),
  59         "->get() multiple unset value returns undef"
  60     );
  61 }
  62
  63 {
  64     my $pcd = Parrot::Configure::Data->new;
  65
  66     my $self = $pcd->set( 'a' => 1 );
  67
  68     # ->set() should return itself
  69     isa_ok( $self, 'Parrot::Configure::Data' );
  70     is( $pcd->get('a'), 1, "->get() returns proper value after ->set()" );
  71 }
  72
  73 {
  74     my $pcd = Parrot::Configure::Data->new;
  75
  76     my $self = $pcd->set(
  77         'a' => 1,
  78         'b' => 2,
  79         'c' => 3,
  80     );
  81
  82     isa_ok( $self, 'Parrot::Configure::Data' );
  83
  84     my @values = $pcd->get(qw(a b c));
  85
  86     is_deeply( \@values, [ 1, 2, 3 ], "->get() returns proper multiple values after ->set()" );
  87 }
  88
  89 # ->add()
  90
  91 {
  92     my $pcd = Parrot::Configure::Data->new;
  93
  94     my $self = $pcd->add( '', 'a' => 1 );
  95
  96     # ->add() should return itself
  97     isa_ok( $self, 'Parrot::Configure::Data' );
  98     is( $pcd->get('a'), 1, "->get() returns proper value after ->add()" );
  99 }
 100
 101 {
 102     my $pcd = Parrot::Configure::Data->new;
 103
 104     my $self = $pcd->add(
 105         '',
 106         'a' => 1,
 107         'b' => 2,
 108         'c' => 3,
 109     );
 110
 111     isa_ok( $self, 'Parrot::Configure::Data' );
 112
 113     my @values = $pcd->get(qw(a b c));
 114
 115     is_deeply( \@values, [ 1, 2, 3 ], "->get() returns proper multiple values after ->add()" );
 116 }
 117
 118 {
 119     my $pcd = Parrot::Configure::Data->new;
 120
 121     $pcd->add( '', 'a' => 1 );
 122     $pcd->add( '', 'a' => 1 );
 123
 124     is( $pcd->get('a'), 11, "->get() returns proper value after ->add()->add()" );
 125 }
 126
 127 {
 128     my $pcd = Parrot::Configure::Data->new;
 129
 130     $pcd->add( '',    'a' => 1 );
 131     $pcd->add( ' - ', 'a' => 1 );
 132
 133     is( $pcd->get('a'), "1 - 1", "->get() returns proper value after ->add()->add()" );
 134 }
 135
 136 # ->keys()
 137
 138 {
 139     my $pcd = Parrot::Configure::Data->new;
 140
 141     my @keys = $pcd->keys;
 142
 143     is_deeply( \@keys, [], "->keys() returns nothing if no keys are set" );
 144 }
 145
 146 {
 147     my $pcd = Parrot::Configure::Data->new;
 148
 149     $pcd->set(
 150         'a' => 1,
 151         'b' => 2,
 152         'c' => 3,
 153     );
 154
 155     # keys is unordered so the result needs to be sorted.  eq_set() could be
 156     # used here instead but it doesn't provide useful diagnostics
 157     my @keys = sort $pcd->keys;
 158
 159     is_deeply( \@keys, [qw(a b c)], "->keys() returns all set keys" );
 160 }
 161
 162 # ->dump()
 163
 164 {
 165     my $pcd = Parrot::Configure::Data->new;
 166
 167     my $data = $pcd->dump( q{c}, q{*PConfig} );
 168
 169     like( $data, qr/\%PConfig = \(\);/, "->dump() returns nothing if no keys are set" );
 170 }
 171
 172 {
 173     my $pcd = Parrot::Configure::Data->new;
 174
 175     $pcd->add(
 176         '',
 177         'a' => 1,
 178         'b' => 2,
 179         'c' => 3,
 180     );
 181     my $data = $pcd->dump( q{c}, q{*PConfig} );
 182
 183     like(
 184         $data,
 185         qr/PConfig = \(\s*'a' => 1,\s*'b' => 2,\s*'c' => 3\s*\);/s,
 186         "->dump() returns the proper values"
 187     );
 188 }
 189
 190 # ->clean()
 191
 192 {
 193     my $pcd = Parrot::Configure::Data->new;
 194
 195     my $self = $pcd->clean;
 196
 197     # ->clean() should return itself
 198     isa_ok( $self, 'Parrot::Configure::Data' );
 199 }
 200
 201 {
 202     my $pcd = Parrot::Configure::Data->new;
 203
 204     $pcd->set( TEMP_FOO => '' );
 205     my $self = $pcd->clean;
 206
 207     is( $pcd->get('TEMP_FOO'), undef, "->clean() removed TEMP_FOO" );
 208 }
 209
 210 {
 211     my $pcd = Parrot::Configure::Data->new;
 212
 213     $pcd->set(
 214         TEMP_FOO => '',
 215         TEMP_BAR => '',
 216         TEMP_BAZ => '',
 217     );
 218     my $self   = $pcd->clean;
 219     my @values = $pcd->get(qw(TEMP_FOO TEMP_BAR TEMP_BAZ));
 220
 221     ok( eq_array( \@values, [ undef, undef, undef ] ), "->clean() removed multiple TEMP_* keys" );
 222 }
 223
 224 # ->settrigger()
 225
 226 {
 227     my $pcd = Parrot::Configure::Data->new;
 228
 229     my $self = $pcd->settrigger( 'foo', 'bar', sub { } );
 230
 231     # ->settrigger() should return itself
 232     isa_ok( $self, 'Parrot::Configure::Data' );
 233 }
 234
 235 {
 236     my $pcd = Parrot::Configure::Data->new;
 237
 238     my $flag = 0;
 239     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 240
 241     is( $flag, 0, "->settrigger() doesn't activate a callback" );
 242 }
 243
 244 {
 245     my $pcd = Parrot::Configure::Data->new;
 246
 247     my $flag = 0;
 248     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 249     $pcd->get('foo');
 250
 251     is( $flag, 0, "->get() doesn't activate the callback" );
 252 }
 253
 254 {
 255     my $pcd = Parrot::Configure::Data->new;
 256
 257     my $flag = 0;
 258     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 259     $pcd->set( foo => 'bar' );
 260
 261     is( $flag, 1, "->set() activates the callback" );
 262 }
 263
 264 {
 265     my $pcd = Parrot::Configure::Data->new;
 266
 267     my $flag = 0;
 268     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 269     $pcd->add( '', foo => 'bar' );
 270
 271     is( $flag, 1, "->add() activates the callback" );
 272 }
 273
 274 {
 275     my $pcd = Parrot::Configure::Data->new;
 276
 277     my $flag1 = 0;
 278     my $flag2 = 0;
 279     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 280     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 281
 282     is( $flag1, 0, "->settrigger() doesn't activate a stacked callback" );
 283     is( $flag2, 0, "->settrigger() doesn't activate a stacked callback" );
 284 }
 285
 286 {
 287     my $pcd = Parrot::Configure::Data->new;
 288
 289     my $flag1 = 0;
 290     my $flag2 = 0;
 291     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 292     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 293     $pcd->get('foo');
 294
 295     is( $flag1, 0, "->get() doesn't activate the stacked callback" );
 296     is( $flag2, 0, "->get() doesn't activate the stacked callback" );
 297 }
 298
 299 {
 300     my $pcd = Parrot::Configure::Data->new;
 301
 302     my $flag1 = 0;
 303     my $flag2 = 0;
 304     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 305     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 306     $pcd->set( foo => 'bar' );
 307
 308     is( $flag1, 1, "->set() activates the stacked callback" );
 309     is( $flag2, 1, "->set() activates the stacked callback" );
 310 }
 311
 312 {
 313     my $pcd = Parrot::Configure::Data->new;
 314
 315     my $flag1 = 0;
 316     my $flag2 = 0;
 317     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 318     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 319     $pcd->add( '', foo => 'bar' );
 320
 321     is( $flag1, 1, "->add() activates the stacked callback" );
 322     is( $flag2, 1, "->add() activates the stacked callback" );
 323 }
 324
 325 # ->gettriggers()
 326
 327 {
 328     my $pcd = Parrot::Configure::Data->new;
 329
 330     my @triggers = $pcd->gettriggers('foo');
 331
 332     is( scalar @triggers, 0, "->gettriggers() returns the proper number of triggers" );
 333 }
 334
 335 {
 336     my $pcd = Parrot::Configure::Data->new;
 337
 338     $pcd->set( foo => 'bar' );
 339     my @triggers = $pcd->gettriggers('foo');
 340
 341     is( scalar @triggers, 0, "->gettriggers() returns the proper number of triggers" );
 342 }
 343
 344 {
 345     my $pcd = Parrot::Configure::Data->new;
 346
 347     my $flag = 0;
 348     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 349     my @triggers = $pcd->gettriggers('foo');
 350
 351     is( $flag, 0, "->gettriggers() doesn't activate the callback" );
 352     is( scalar @triggers, 1, "->gettriggers() returns the proper number of triggers" );
 353 }
 354
 355 {
 356     my $pcd = Parrot::Configure::Data->new;
 357
 358     my $flag1 = 0;
 359     my $flag2 = 0;
 360     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 361     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 362     my @triggers = $pcd->gettriggers('foo');
 363
 364     is( $flag1,           0, "->gettriggers() doesn't activate the stacked callback" );
 365     is( $flag2,           0, "->gettriggers() doesn't activate the stacked callback" );
 366     is( scalar @triggers, 2, "->gettriggers() returns the proper number of triggers" );
 367 }
 368
 369 # ->gettrigger()
 370
 371 {
 372     my $pcd = Parrot::Configure::Data->new;
 373
 374     is( $pcd->gettrigger('foo'),
 375         undef, "->gettrigger() unset value returns undef in scalar context" );
 376     is( ( $pcd->gettrigger('foo') ),
 377         undef, "->gettrigger() unset value returns undef in list context" );
 378 }
 379
 380 {
 381     my $pcd = Parrot::Configure::Data->new;
 382
 383     my $flag = 0;
 384     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 385     my $trigger = $pcd->gettrigger( 'foo', 'bar' );
 386
 387     is( $flag, 0, "->gettrigger() doesn't activate the callback" );
 388     is( ref $trigger, 'CODE', "->gettrigger() returns a code ref" );
 389 }
 390
 391 {
 392     my $pcd = Parrot::Configure::Data->new;
 393
 394     my $flag1 = 0;
 395     my $flag2 = 0;
 396     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 397     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 398     my $trigger = $pcd->gettrigger( 'foo', 'bar' );
 399
 400     is( $flag1,       0,      "->gettrigger() doesn't activate the stacked callback" );
 401     is( $flag2,       0,      "->gettrigger() doesn't activate the stacked callback" );
 402     is( ref $trigger, 'CODE', "->gettrigger() returns a code ref" );
 403     &$trigger;
 404     is( $flag1, 1, "->gettrigger() returned the correct callback" );
 405     is( $flag2, 0, "->gettrigger() returned the correct callback" );
 406 }
 407
 408 {
 409     my $pcd = Parrot::Configure::Data->new;
 410
 411     my $flag1 = 0;
 412     my $flag2 = 0;
 413     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 414     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 415     my $trigger = $pcd->gettrigger( 'foo', 'baz' );
 416
 417     is( $flag1,       0,      "->gettrigger() doesn't activate the stacked callback" );
 418     is( $flag2,       0,      "->gettrigger() doesn't activate the stacked callback" );
 419     is( ref $trigger, 'CODE', "->gettrigger() returns a code ref" );
 420     &$trigger;
 421     is( $flag1, 0, "->gettrigger() returned the correct callback" );
 422     is( $flag2, 1, "->gettrigger() returned the correct callback" );
 423 }
 424
 425 # ->deltrigger()
 426
 427 {
 428     my $pcd = Parrot::Configure::Data->new;
 429
 430     my $self = $pcd->deltrigger( 'foo', 'bar' );
 431
 432     is( $self, undef, '->deltrigger() returns undef on failure' );
 433 }
 434
 435 {
 436     my $pcd = Parrot::Configure::Data->new;
 437
 438     my $flag = 0;
 439     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 440     my $self = $pcd->deltrigger( 'foo', 'bar' );
 441
 442     # ->deltrigger() should return itself on success
 443     isa_ok( $self, 'Parrot::Configure::Data' );
 444 }
 445
 446 {
 447     my $pcd = Parrot::Configure::Data->new;
 448
 449     my $flag = 0;
 450     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 451     $pcd->deltrigger( 'foo', 'bar' );
 452
 453     is( $pcd->gettrigger( 'foo', 'bar' ), undef, "->deltrigger() removed the callback" );
 454 }
 455
 456 {
 457     my $pcd = Parrot::Configure::Data->new;
 458
 459     my $flag1 = 0;
 460     my $flag2 = 0;
 461     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 462     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 463     $pcd->deltrigger( 'foo', 'bar' );
 464
 465     is( $pcd->gettrigger( 'foo', 'bar' ), undef, "->deltrigger() removed the stacked callback" );
 466     is( ref $pcd->gettrigger( 'foo', 'baz' ),
 467         'CODE', "->deltrigger() removed the stacked callback" );
 468 }
 469
 470 {
 471     my $pcd = Parrot::Configure::Data->new;
 472
 473     my $flag1 = 0;
 474     my $flag2 = 0;
 475     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 476     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 477     $pcd->deltrigger( 'foo', 'baz' );
 478
 479     is( $pcd->gettrigger( 'foo', 'baz' ), undef, "->deltrigger() removed the stacked callback" );
 480     is( ref $pcd->gettrigger( 'foo', 'bar' ),
 481         'CODE', "->deltrigger() removed the stacked callback" );
 482 }
 483
 484 {
 485     my $pcd = Parrot::Configure::Data->new;
 486
 487     my $flag = 0;
 488     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 489     $pcd->deltrigger( 'foo', 'bar' );
 490
 491     is( $flag, 0, "->deltrigger() doesn't activate the callback" );
 492 }
 493
 494 {
 495     my $pcd = Parrot::Configure::Data->new;
 496
 497     my $flag = 0;
 498     $pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
 499     $pcd->deltrigger( 'foo', 'bar' );
 500
 501     is( $flag, 0, "->deltrigger() doesn't activate the callback" );
 502 }
 503
 504 {
 505     my $pcd = Parrot::Configure::Data->new;
 506
 507     my $flag1 = 0;
 508     my $flag2 = 0;
 509     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 510     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 511     $pcd->deltrigger( 'foo', 'bar' );
 512
 513     is( $flag1, 0, "->deltrigger() doesn't activate the stacked callback" );
 514     is( $flag2, 0, "->deltrigger() doesn't activate the stacked callback" );
 515 }
 516
 517 {
 518     my $pcd = Parrot::Configure::Data->new;
 519
 520     my $flag1 = 0;
 521     my $flag2 = 0;
 522     $pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
 523     $pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
 524     $pcd->deltrigger( 'foo', 'baz' );
 525
 526     is( $flag1, 0, "->deltrigger() doesn't activate the stacked callback" );
 527     is( $flag2, 0, "->deltrigger() doesn't activate the stacked callback" );
 528 }
 529
 530 # Local Variables:
 531 #   mode: cperl
 532 #   cperl-indent-level: 4
 533 #   fill-column: 100
 534 # End:
 535 # vim: expandtab shiftwidth=4: