#! /usr/bin/perl
#  Copyright (C) 2010, Geoffrey Leach
#===============================================================================
#
#         FILE:  01.basic.t
#
#  DESCRIPTION:  Test the construction of internal data structures
#
#        FILES:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  Geoffrey Leach (), <geoff@hughes.net>
#      COMPANY:
#      VERSION:  1.9.7
#      CREATED:  07/06/2009 03:27:58 PM PDT
#     REVISION:  ---
#===============================================================================

use strict;
use warnings;

use Test::More tests => 6;
use Test::Output;
use Getopt::Auto( { test => 1, nohelp=>1 } );

use 5.006;
our $VERSION = '1.9.7';

## no critic (ProhibitImplicitNewlines)
## no critic (ProtectPrivateSubs)
## no critic (RequireLocalizedPunctuationVars)
## no critic (ProtectPrivateVars)
## no critic (ProhibitPackageVars)

our %options;    # Will be set by Getopt::Auto; 'our' is required for that

my @exspec = (
    [   '--foo', 'do a foo', 'Test
', \&foo
    ]
);

my %ex_options = (
    '--foo' => {
        'longhelp' => 'Test
',
        'code'       => \&foo,
        'shorthelp'  => 'do a foo',
        'options'    => 'main::options',
        'package'    => 'main',
        'registered' => 1,
    },
    '--version' => {
        'shorthelp'  => 'Prints the version number',
        'code'       => \&Getopt::Auto::_version,
        'registered' => 1,
    },
    '--help' => {
        'shorthelp'  => 'This text',
        'code'       => \&Getopt::Auto::_help,
        'registered' => 1,
    },
);

is_deeply( Getopt::Auto::_get_spec_ref(),
    \@exspec, 'Spec gets built correctly' );
is_deeply( Getopt::Auto::_get_options_ref(),
    \%ex_options, '... and gets converted to options OK' );

# Now, if all is proceeding according to plan, we are set up to expect option
# --foo. $is_foo_called will be set to 1 if the subroutine foo() implied by the
# --foo option is called. We also have here a "short" option, -x, which has
# not been specified in advance, so we expect that $main::options->{x} will not be set

my $is_foo_called = 0;
sub foo { ++$is_foo_called; return; }

@ARGV = qw( -x --foo );
stderr_is(
    \&Getopt::Auto::_parse_args,
    "Getopt::Auto: -x is not a registered option\n",
    '-x not registered'
);
ok( $is_foo_called, 'Sub foo() was called' );
isnt( $options{'x'}, 1, 'option "x" was not set' );

# The most basic situation is the one where there are no options given
@ARGV = qw( /twas/brillig/and/the/slythe/toes );
stderr_isnt(
    \&Getopt::Auto::_parse_args,
    "Getopt::Auto:  /twas/brillig/and/the/slythe/toes is not a registered option\n",
    '/twas/brillig/and/the/slythe/toes not flagged'
);

exit 0;

__END__

=pod

=head2 --foo - do a foo

Test

=cut