view release on metacpan or  search on metacpan

t/core/utils.t  view on Meta::CPAN

#============================================================= -*-perl-*-
#
# t/core/utils.t
#
# Test the Badger::Utils module.
#
# Written by Andy Wardley <abw@wardley.org>.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================

use strict;
use warnings;

use lib qw( t/core/lib ./lib ../lib ../../lib );
use Badger::Debug modules => 'Badger::Utils';
use Badger::Utils 'UTILS blessed xprintf reftype textlike plural permute_fragments';
use Badger::Test
    tests => 118,
    debug => 'Badger::Utils',
    args  => \@ARGV;

is( UTILS, 'Badger::Utils', 'got UTILS defined' );
ok( blessed bless([], 'Wibble'), 'got blessed' );


#-----------------------------------------------------------------------
# test is_object()
#-----------------------------------------------------------------------

package My::Base;
use base 'Badger::Base';

package My::Sub;
use base 'My::Base';

package main;
use Badger::Utils 'is_object';

my $obj = My::Sub->new;
ok(   is_object( 'My::Sub'   => $obj ), 'object is a My::Sub' );
ok(   is_object( 'My::Base'  => $obj ), 'object is a My::Base' );
ok( ! is_object( 'My::Other' => $obj ), 'object is not My::Other' );


#-----------------------------------------------------------------------
# test params() and self_params()
#-----------------------------------------------------------------------

use Badger::Utils 'params';

my $hash = {
    a => 10,
    b => 20,
};
is( params($hash), $hash, 'params returns hash ref' );
is( params(%$hash)->{ a }, 10, 'params merged named param list' );


package Selfish;

use Badger::Class
    base    => 'Badger::Base',
    as_text => 'text',                  # for testing textlike()
    utils   => 'self_params';

sub test1 {
    my ($self, $params) = self_params(@_);
    return ($self, $params);
}

sub text {                              # for testing textlike()
    return 'Hello World';
}

package main;
my $selfish = Selfish->new();

t/core/utils.t  view on Meta::CPAN

use Badger::Utils 'Logic';

my $logic = Logic('cheese and biscuits');
ok( blessed $logic && $logic->isa('Badger::Logic'), 'Logic returned a Badger::Logic object' );


#-----------------------------------------------------------------------
# Import from Badger::Filesystem
#-----------------------------------------------------------------------

use Badger::Utils 'Bin';

my $bin = Bin;
ok( blessed $bin && $bin->isa('Badger::Filesystem::Directory'), "Bin is $bin" );



#-----------------------------------------------------------------------
# test plural()
#-----------------------------------------------------------------------

is( plural('gateway'), 'gateways', 'pluralised gateway/gateways' );
is( plural('fairy'), 'fairies', 'pluralised fairy/fairies' );


#-----------------------------------------------------------------------
# test random_name()
#-----------------------------------------------------------------------

use Badger::Utils 'random_name';

is( length random_name(), $Badger::Utils::RANDOM_NAME_LENGTH,
    "default random_name() length is $Badger::Utils::RANDOM_NAME_LENGTH" );
is( length random_name(16), 16, 'random_name(16) length is 16');
is( length random_name(32), 32, 'random_name(16) length is 32');
is( length random_name(48), 48, 'random_name(16) length is 48');
is( length random_name(64), 64, 'random_name(16) length is 64');


#-----------------------------------------------------------------------
# test camel_case() and CamelCase
#-----------------------------------------------------------------------

use Badger::Utils 'camel_case CamelCase';

is( camel_case('hello_world'), 'HelloWorld',
   "camel_case('hello_world') => 'HelloWorld'"
);
is( camel_case('FOO_bar'), 'FOOBar',
   "camel_case('FOO_bar') => 'FOOBar'"
);

is( CamelCase('hello_world'), 'HelloWorld',
   "CamelCase('hello_world') => 'HelloWorld'"
);



#-----------------------------------------------------------------------
# test permute_fragments()
#-----------------------------------------------------------------------

test_permute('foo', 'foo');
test_permute('Template(X)', 'Template', 'TemplateX');
test_permute('Template(X|)', 'TemplateX', 'Template');
test_permute(
    'Template(X)::(XS::TT3|TT3)::Foo',
    'Template::XS::TT3::Foo',
    'Template::TT3::Foo',
    'TemplateX::XS::TT3::Foo',
    'TemplateX::TT3::Foo',
);

sub test_permute {
    my $input   = shift;
    my @outputs = permute_fragments($input);
#    print("  INPUT: $input\n");
#    print("OUTPUTS: ", join(', ', @outputs), "\n");

    foreach my $output (@outputs) {
        if (@_) {
            my $expect = shift;
            is( $output, $expect, "$input => $expect" );
        }
        else {
            fail("$input permuted unexpected value: $output");
        }
    }
    foreach my $expect (@_) {
        fail("$input did not permute expected value: $expect");
    }
}


#-----------------------------------------------------------------------------
# test hash_each() and list_each
#-----------------------------------------------------------------------------

my @each;

use Badger::Utils 'hash_each list_each';

hash_each(
    { a => 10, b => 20 },
    sub {
        my ($hash, $key, $value) = @_;
        push(@each, "$key:$value");
    }
);
is( join(', ', sort @each), "a:10, b:20", 'hash_each()' );

@each = ();

list_each(
    [ 30, 40, 50 ],
    sub {
        my ($list, $index, $value) = @_;
        push(@each, "$index:$value");
    }
);
is( join(', ', sort @each), "0:30, 1:40, 2:50", 'list_each()' );

#-----------------------------------------------------------------------------
# test split_to_list()
#-----------------------------------------------------------------------------

use Badger::Utils 'split_to_list';

is(
    join(', ', @{ split_to_list('a b c') }),
    'a, b, c',
    'split_to_list("a b c")'
);

is(
    join(' + ', @{ split_to_list('a, b,c') }),