1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
|
use strict;
use warnings;
use Test::NoWarnings;
use Test::More tests => 29;
use lib './lib';
use File::Util;
my $ftl = File::Util->new();
# ::Modern should be able to do everthing ::Classic does, so we're going to
# run all the same tests on ::Modern that we do on ::Classic, and after
# that we are going to target the things that only ::Modern can do.
# BEGIN BACK-COMPAT TESTS
# testing _myargs() with back-compat
is_deeply [ $ftl->_myargs( qw/ a b c / ) ],
[ qw/ a b c / ],
'_myargs() understands a flat list';
is $ftl->_myargs( 'a' ),
'a',
'...and knows what to do in list context' ;
is scalar $ftl->_myargs( qw/ a b c / ),
'a',
'...and knows what to do in scalar context';
# testing $ftl->_remove_opts() with back-compat
is $ftl->_remove_opts( 'a' ),
undef,
'$ftl->_remove_opts() ignores non-opts type single arg, and returns undef';
is $ftl->_remove_opts( qw/ a b c / ),
undef,
'...and ignores non-opts type multi arg list, and returns undef';
is_deeply
$ftl->_remove_opts( [ qw/ --name=Larry --lang=Perl --recurse --empty= / ] ),
{
'--name' => 'Larry',
'name' => 'Larry',
'--lang' => 'Perl',
'lang' => 'Perl',
'--recurse' => 1,
'recurse' => 1,
'--empty' => '',
'empty' => '',
},
'...and recognizes + returns --name=value pairs, --flags, and --empty=';
is_deeply
$ftl->_remove_opts(
[
qw/ --verbose --8-ball=black --empty= /,
]
),
{
'--verbose' => 1,
'verbose' => 1,
'--8-ball' => 'black',
'8_ball' => 'black',
'--empty' => '',
'empty' => '',
},
'...and still does the same with some slightly different input';
is_deeply
$ftl->_remove_opts( [ 0, '', undef, '--mcninja', undef ] ),
{ qw/ mcninja 1 --mcninja 1 / },
'...and works right even with some bad args';
# testing $ftl->_names_values() with back-compat
is_deeply
$ftl->_names_values( qw/ a a b b c c d d e e / ),
{ a => a => b => b => c => c => d => d => e => e => },
'$ftl->_names_values() converts even-numbered args list to balanced hashref';
is_deeply
$ftl->_names_values( a => 'a', 'b' ),
{ a => a => b => undef },
'...and sets final name-value pair to value=undef for unbalanced lists';
is_deeply
$ftl->_names_values( a => 'a', b => 'b', ( undef, 'u' ), c => 'c' ), # foolishness
{ a => a => b => b => c => c => }, # ...should go ignored (at least here)
'...and ignores name-value pair in balanced list when name itself is undef';
# BACK COMPAT TESTS DONE. Now test ::Modern interface
# testing _myargs() - no testing needed because it works the same in ::Modern
# since it is imported from ::Classic
# testing $ftl->_remove_opts()
is_deeply
$ftl->_remove_opts(
[
{ name => 'Larry', lang => 'Perl', recurse => 1, empty => undef }
]
),
{
name => 'Larry',
lang => 'Perl',
recurse => 1,
empty => undef,
},
'$ftl->_remove_opts() recognizes + returns { name => value } pairs, and flags';
is_deeply
$ftl->_remove_opts(
[
{ verbose => 1, '8_ball' => 'black', empty => '' },
]
),
{
verbose => 1,
'8_ball' => 'black',
empty => '',
},
'...and does the same with slightly different input';
is $ftl->_remove_opts( ), undef, '...and returns undef if given no args';
is $ftl->_remove_opts( undef ), undef, '...and returns undef if given undef';
is_deeply $ftl->_remove_opts( [ undef, 0, '' ] ),
{ },
'...and returns empty hashref if given listref of falsies';
is_deeply
$ftl->_remove_opts( [ ] ),
{ },
'...and returns an empty hashref if given an empty listref of args';
is_deeply
$ftl->_remove_opts(
[
{ verbose => 1, '8_ball' => 'black' }, { empty => '' },
]
),
{
verbose => 1,
'8_ball' => 'black',
empty => '',
},
'...and still does the same if args list contains multiple hashrefs';
is_deeply
$ftl->_remove_opts(
[
{ verbose => 1, '8_ball' => 'black' }, undef, { empty => '' },
]
),
{
verbose => 1,
'8_ball' => 'black',
empty => '',
},
'...and still does the same if args list is interspersed with undef\'s';
# testing $ftl->_names_values()
is_deeply
$ftl->_names_values( { qw/ a a b b c c d d e e / } ),
{ a => a => b => b => c => c => d => d => e => e => },
'$ftl->_names_values() compares perfectly from input hashref to args hashref';
is_deeply
$ftl->_names_values( ),
{ },
'...and returns an empty hashref if given no args';
is_deeply
$ftl->_names_values( { } ),
{ },
'...and returns an empty hashref if given an empty hashref as only arg';
is_deeply
$ftl->_parse_in(
{ qw/ a a b b c c d d e e / }
),
{ a => a => b => b => c => c => d => d => e => e => },
'$ftl->_parse_in() and understands a hashref';
is_deeply $ftl->_parse_in( ), { },
'...and returns an empty hashref if given no args';
is_deeply $ftl->_parse_in( { } ), { },
'...and does the same if given an empty hashref';
is_deeply
$ftl->_parse_in(
{ qw/ a a / }, { qw/ b b / }, { qw/ c c / }, { qw/ d d e e / }
),
{ a => a => b => b => c => c => d => d => e => e => },
'...and understands and amalgamates a list of hashrefs';
is_deeply
$ftl->_parse_in(
{ qw/ a a / }, b => 'b', '--c=c', { qw/ d d e e / }, '--f'
),
{
a => 'a',
b => 'b',
c => 'c',
d => 'd',
e => 'e',
f => 1,
'--c' => 'c',
'--f' => 1,
},
'...and understands a mixture of old and new style input args';
is File::Util::Interface::Modern::DESTROY(), undef, '::DESTROY() returns undef';
exit;
|