The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

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;