Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
535 lines (387 sloc) 12.8 KB
#!perl
# Copyright (C) 2001-2005, Parrot Foundation.
use strict;
use warnings;
use lib qw( lib );
use Test::More tests => 69;
=head1 NAME
t/configure/032-data.t - tests Parrot::Configure::Data
=head1 SYNOPSIS
prove t/configure/032-data.t
=head1 DESCRIPTION
Regressions tests for the L<Parrote::Configure::Data> class.
=cut
BEGIN { use Parrot::Configure::Data; }
can_ok(
'Parrot::Configure::Data', qw(
new
get
set
keys
dump
clean
settrigger
gettriggers
gettrigger
deltrigger
)
);
{
my $pcd = Parrot::Configure::Data->new;
isa_ok( $pcd, 'Parrot::Configure::Data' );
}
# ->get() / ->set()
{
my $pcd = Parrot::Configure::Data->new;
is( $pcd->get('a'), undef, "->get() unset value returns undef in scalar context" );
is( ( $pcd->get('a') ), undef, "->get() unset value returns undef in list context" );
my @values = $pcd->get(qw(a b c));
ok(
eq_array( \@values, [ undef, undef, undef ] ),
"->get() multiple unset value returns undef"
);
}
{
my $pcd = Parrot::Configure::Data->new;
my $self = $pcd->set( 'a' => 1 );
# ->set() should return itself
isa_ok( $self, 'Parrot::Configure::Data' );
is( $pcd->get('a'), 1, "->get() returns proper value after ->set()" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $self = $pcd->set(
'a' => 1,
'b' => 2,
'c' => 3,
);
isa_ok( $self, 'Parrot::Configure::Data' );
my @values = $pcd->get(qw(a b c));
is_deeply( \@values, [ 1, 2, 3 ], "->get() returns proper multiple values after ->set()" );
}
# ->add()
{
my $pcd = Parrot::Configure::Data->new;
my $self = $pcd->add( '', 'a' => 1 );
# ->add() should return itself
isa_ok( $self, 'Parrot::Configure::Data' );
is( $pcd->get('a'), 1, "->get() returns proper value after ->add()" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $self = $pcd->add(
'',
'a' => 1,
'b' => 2,
'c' => 3,
);
isa_ok( $self, 'Parrot::Configure::Data' );
my @values = $pcd->get(qw(a b c));
is_deeply( \@values, [ 1, 2, 3 ], "->get() returns proper multiple values after ->add()" );
}
{
my $pcd = Parrot::Configure::Data->new;
$pcd->add( '', 'a' => 1 );
$pcd->add( '', 'a' => 1 );
is( $pcd->get('a'), 11, "->get() returns proper value after ->add()->add()" );
}
{
my $pcd = Parrot::Configure::Data->new;
$pcd->add( '', 'a' => 1 );
$pcd->add( ' - ', 'a' => 1 );
is( $pcd->get('a'), "1 - 1", "->get() returns proper value after ->add()->add()" );
}
# ->keys()
{
my $pcd = Parrot::Configure::Data->new;
my @keys = $pcd->keys;
is_deeply( \@keys, [], "->keys() returns nothing if no keys are set" );
}
{
my $pcd = Parrot::Configure::Data->new;
$pcd->set(
'a' => 1,
'b' => 2,
'c' => 3,
);
# keys is unordered so the result needs to be sorted. eq_set() could be
# used here instead but it doesn't provide useful diagnostics
my @keys = sort $pcd->keys;
is_deeply( \@keys, [qw(a b c)], "->keys() returns all set keys" );
}
# ->dump()
{
my $pcd = Parrot::Configure::Data->new;
my $data = $pcd->dump( q{c}, q{*PConfig} );
like( $data, qr/\%PConfig = \(\);/, "->dump() returns nothing if no keys are set" );
}
{
my $pcd = Parrot::Configure::Data->new;
$pcd->add(
'',
'a' => 1,
'b' => 2,
'c' => 3,
);
my $data = $pcd->dump( q{c}, q{*PConfig} );
like(
$data,
qr/PConfig = \(\s*'a' => 1,\s*'b' => 2,\s*'c' => 3\s*\);/s,
"->dump() returns the proper values"
);
}
# ->clean()
{
my $pcd = Parrot::Configure::Data->new;
my $self = $pcd->clean;
# ->clean() should return itself
isa_ok( $self, 'Parrot::Configure::Data' );
}
{
my $pcd = Parrot::Configure::Data->new;
$pcd->set( TEMP_FOO => '' );
my $self = $pcd->clean;
is( $pcd->get('TEMP_FOO'), undef, "->clean() removed TEMP_FOO" );
}
{
my $pcd = Parrot::Configure::Data->new;
$pcd->set(
TEMP_FOO => '',
TEMP_BAR => '',
TEMP_BAZ => '',
);
my $self = $pcd->clean;
my @values = $pcd->get(qw(TEMP_FOO TEMP_BAR TEMP_BAZ));
ok( eq_array( \@values, [ undef, undef, undef ] ), "->clean() removed multiple TEMP_* keys" );
}
# ->settrigger()
{
my $pcd = Parrot::Configure::Data->new;
my $self = $pcd->settrigger( 'foo', 'bar', sub { } );
# ->settrigger() should return itself
isa_ok( $self, 'Parrot::Configure::Data' );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
is( $flag, 0, "->settrigger() doesn't activate a callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
$pcd->get('foo');
is( $flag, 0, "->get() doesn't activate the callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
$pcd->set( foo => 'bar' );
is( $flag, 1, "->set() activates the callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
$pcd->add( '', foo => 'bar' );
is( $flag, 1, "->add() activates the callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
is( $flag1, 0, "->settrigger() doesn't activate a stacked callback" );
is( $flag2, 0, "->settrigger() doesn't activate a stacked callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
$pcd->get('foo');
is( $flag1, 0, "->get() doesn't activate the stacked callback" );
is( $flag2, 0, "->get() doesn't activate the stacked callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
$pcd->set( foo => 'bar' );
is( $flag1, 1, "->set() activates the stacked callback" );
is( $flag2, 1, "->set() activates the stacked callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
$pcd->add( '', foo => 'bar' );
is( $flag1, 1, "->add() activates the stacked callback" );
is( $flag2, 1, "->add() activates the stacked callback" );
}
# ->gettriggers()
{
my $pcd = Parrot::Configure::Data->new;
my @triggers = $pcd->gettriggers('foo');
is( scalar @triggers, 0, "->gettriggers() returns the proper number of triggers" );
}
{
my $pcd = Parrot::Configure::Data->new;
$pcd->set( foo => 'bar' );
my @triggers = $pcd->gettriggers('foo');
is( scalar @triggers, 0, "->gettriggers() returns the proper number of triggers" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
my @triggers = $pcd->gettriggers('foo');
is( $flag, 0, "->gettriggers() doesn't activate the callback" );
is( scalar @triggers, 1, "->gettriggers() returns the proper number of triggers" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
my @triggers = $pcd->gettriggers('foo');
is( $flag1, 0, "->gettriggers() doesn't activate the stacked callback" );
is( $flag2, 0, "->gettriggers() doesn't activate the stacked callback" );
is( scalar @triggers, 2, "->gettriggers() returns the proper number of triggers" );
}
# ->gettrigger()
{
my $pcd = Parrot::Configure::Data->new;
is( $pcd->gettrigger('foo'),
undef, "->gettrigger() unset value returns undef in scalar context" );
is( ( $pcd->gettrigger('foo') ),
undef, "->gettrigger() unset value returns undef in list context" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
my $trigger = $pcd->gettrigger( 'foo', 'bar' );
is( $flag, 0, "->gettrigger() doesn't activate the callback" );
is( ref $trigger, 'CODE', "->gettrigger() returns a code ref" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
my $trigger = $pcd->gettrigger( 'foo', 'bar' );
is( $flag1, 0, "->gettrigger() doesn't activate the stacked callback" );
is( $flag2, 0, "->gettrigger() doesn't activate the stacked callback" );
is( ref $trigger, 'CODE', "->gettrigger() returns a code ref" );
&$trigger;
is( $flag1, 1, "->gettrigger() returned the correct callback" );
is( $flag2, 0, "->gettrigger() returned the correct callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
my $trigger = $pcd->gettrigger( 'foo', 'baz' );
is( $flag1, 0, "->gettrigger() doesn't activate the stacked callback" );
is( $flag2, 0, "->gettrigger() doesn't activate the stacked callback" );
is( ref $trigger, 'CODE', "->gettrigger() returns a code ref" );
&$trigger;
is( $flag1, 0, "->gettrigger() returned the correct callback" );
is( $flag2, 1, "->gettrigger() returned the correct callback" );
}
# ->deltrigger()
{
my $pcd = Parrot::Configure::Data->new;
my $self = $pcd->deltrigger( 'foo', 'bar' );
is( $self, undef, '->deltrigger() returns undef on failure' );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
my $self = $pcd->deltrigger( 'foo', 'bar' );
# ->deltrigger() should return itself on success
isa_ok( $self, 'Parrot::Configure::Data' );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
$pcd->deltrigger( 'foo', 'bar' );
is( $pcd->gettrigger( 'foo', 'bar' ), undef, "->deltrigger() removed the callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
$pcd->deltrigger( 'foo', 'bar' );
is( $pcd->gettrigger( 'foo', 'bar' ), undef, "->deltrigger() removed the stacked callback" );
is( ref $pcd->gettrigger( 'foo', 'baz' ),
'CODE', "->deltrigger() removed the stacked callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
$pcd->deltrigger( 'foo', 'baz' );
is( $pcd->gettrigger( 'foo', 'baz' ), undef, "->deltrigger() removed the stacked callback" );
is( ref $pcd->gettrigger( 'foo', 'bar' ),
'CODE', "->deltrigger() removed the stacked callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
$pcd->deltrigger( 'foo', 'bar' );
is( $flag, 0, "->deltrigger() doesn't activate the callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag = 1 } );
$pcd->deltrigger( 'foo', 'bar' );
is( $flag, 0, "->deltrigger() doesn't activate the callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
$pcd->deltrigger( 'foo', 'bar' );
is( $flag1, 0, "->deltrigger() doesn't activate the stacked callback" );
is( $flag2, 0, "->deltrigger() doesn't activate the stacked callback" );
}
{
my $pcd = Parrot::Configure::Data->new;
my $flag1 = 0;
my $flag2 = 0;
$pcd->settrigger( 'foo', 'bar', sub { $flag1 = 1 } );
$pcd->settrigger( 'foo', 'baz', sub { $flag2 = 1 } );
$pcd->deltrigger( 'foo', 'baz' );
is( $flag1, 0, "->deltrigger() doesn't activate the stacked callback" );
is( $flag2, 0, "->deltrigger() doesn't activate the stacked callback" );
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.