#!/usr/bin/perl -T
use strict;
use warnings;
=head1 TEST PURPOSE
These tests check export group expansion, name prefixing, and option merging.
=cut
use Test::More tests => 55;
BEGIN { use_ok('Sub::Exporter'); }
my $import_target;
my $config = {
exports => [ qw(a b c) ],
groups => {
A => [ 'a' ],
B => [ qw(b c) ],
C => [ qw(a b :C) ],
D => [ qw(:A :B) ],
a_as_b => [ a => { -as => 'b' } ],
prefixed_A => [ -A => { -prefix => 'alfa_' } ],
suffixed_A => [ -A => { -suffix => '_yankee' } ],
diprefixed_A => [ -prefixed_A => { -prefix => 'bravo_' } ],
disuffixed_A => [ -suffixed_A => { -suffix => '_zulu' } ],
presuffixed_A=> [ -A => { -prefix => 'freakin_', -suffix => '_right' } ],
a_to_subref => [ a => { -as => \$import_target }, 'b' ],
prefixed_a_s => [ -a_to_subref => { -prefix => 'alfa_' } ],
}
};
my @single_tests = (
[ "simple group 1", [ ':A' => undef ] => [ [ a => undef ] ] ],
[ "simple group 2", [ ':B' => undef ] => [ [ b => undef ], [ c => undef ] ] ],
[
"group of groups",
[ ':D' => undef ],
[ [ a => undef ], [ b => undef ], [ c => undef ] ],
],
[
"recursive group",
[ ':C' => undef ],
[ [ a => undef ], [b => undef ] ],
],
[
"group with empty args",
[ -A => { } ],
[ [ a => undef ] ],
],
[
"group with prefix",
[ -A => { -prefix => 'alpha_' } ],
[ [ a => { -as => 'alpha_a' } ] ],
],
[
"group with suffix",
[ -A => { -suffix => '_import' } ],
[ [ a => { -as => 'a_import' } ] ],
],
[
"recursive group with prefix",
[ -C => { -prefix => 'kappa_' } ],
[ [ a => { -as => 'kappa_a' } ], [ b => { -as => 'kappa_b' } ] ],
],
[
"recursive group with suffix",
[ -C => { -suffix => '_etc' } ],
[ [ a => { -as => 'a_etc' } ], [ b => { -as => 'b_etc' } ] ],
],
[
"group that renames",
[ -a_as_b => undef ],
[ [ a => { -as => 'b' } ] ],
],
[
"group that renames, with options",
[ -a_as_b => { foo => 10 } ],
[ [ a => { -as => 'b', foo => 10 } ] ],
],
[
"group that renames, with a prefix",
[ -a_as_b => { -prefix => 'not_really_' } ],
[ [ a => { -as => 'not_really_b' } ] ],
],
[
"group that renames, with a suffix",
[ -a_as_b => { -suffix => '_or_not' } ],
[ [ a => { -as => 'b_or_not' } ] ],
],
[
"group that renames, with a prefix and suffix",
[ -a_as_b => { -prefix => 'not_really_' } ],
[ [ a => { -as => 'not_really_b' } ] ],
],
[
"recursive group with a built-in prefix",
[ -prefixed_A => undef ],
[ [ a => { -as => 'alfa_a' } ] ],
],
[
"recursive group with built-in and passed-in prefix",
[ -prefixed_A => { -prefix => 'bravo_' } ],
[ [ a => { -as => 'bravo_alfa_a' } ] ],
],
[
"recursive group with built-in and passed-in suffix",
[ -suffixed_A => { -suffix => '_zulu' } ],
[ [ a => { -as => 'a_yankee_zulu' } ] ],
],
[
"multi-prefixed group",
[ -diprefixed_A => undef ],
[ [ a => { -as => 'bravo_alfa_a' } ] ],
],
[
"multi-suffixed group",
[ -disuffixed_A => undef ],
[ [ a => { -as => 'a_yankee_zulu' } ] ],
],
[
"multi-prefixed group with prefix",
[ -diprefixed_A => { -prefix => 'charlie_' } ],
[ [ a => { -as => 'charlie_bravo_alfa_a' } ] ],
],
[
"group with built-in prefix and suffix",
[ -presuffixed_A => undef ],
[ [ a => { -as => 'freakin_a_right' } ] ],
],
[
"group with built-in prefix and suffix, plus prefix",
[ -presuffixed_A => { -prefix => 'totally_' } ],
[ [ a => { -as => 'totally_freakin_a_right' } ] ],
],
[
"group with built-in prefix and suffix, plus suffix",
[ -presuffixed_A => { -suffix => '_dude' } ],
[ [ a => { -as => 'freakin_a_right_dude' } ] ],
],
[
"group with built-in prefix and suffix, plus prefix and suffix",
[ -presuffixed_A => { -prefix => 'totally_', -suffix => '_dude' } ],
[ [ a => { -as => 'totally_freakin_a_right_dude' } ] ],
],
[
"group that exports to scalar (unusual)",
[ -a_to_subref => undef ],
[ [ a => { -as => \$import_target } ], [ b => undef ] ],
],
[
"group that exports to scalar, with prefix",
[ -a_to_subref => { -prefix => 'jubju' } ],
[ [ a => { -as => \$import_target } ], [ b => { -as => 'jubjub' } ] ],
],
);
for my $test (@single_tests) {
my ($label, $given, $expected) = @$test;
my @got = Sub::Exporter::_expand_group(
'Class',
$config,
$given,
{},
);
is_deeply(\@got, $expected, "expand_group: $label");
}
for my $test (@single_tests) {
my ($label, $given, $expected) = @$test;
my $got = Sub::Exporter::_expand_groups(
'Class',
$config,
[ $given ],
);
is_deeply($got, $expected, "expand_groups: $label [single test]");
}
my @multi_tests = (
[
"group and export",
[ [ ':A', undef ], [ c => undef ] ],
[ [ a => undef ], [ c => undef ] ]
],
[
"two groups with different merges",
[ [ -A => { -prefix => 'A_' } ], [ -prefixed_A => { -suffix => '_p' } ] ],
[
[ a => { -as => 'A_a' } ],
[ a => { -as => 'alfa_a_p' } ],
]
],
);
for my $test (@multi_tests) {
my ($label, $given, $expected) = @$test;
my $got = Sub::Exporter::_expand_groups(
'Class',
$config,
$given,
);
is_deeply($got, $expected, "expand_groups: $label");
}