#! /usr/bin/perl
# Copyright (C) 2010, Geoffrey Leach
#===============================================================================
#
# FILE: 03-options_text.t
#
# DESCRIPTION: Test some variations on the text in POD options
#
# FILES: ---
# BUGS: ---
# NOTES: ---
# AUTHOR: Geoffrey Leach (), geoff@hughes.net
# COMPANY:
# VERSION: 1.9.7
# CREATED: 11/05/2009 04:31:11 PM
# REVISION: ---
#===============================================================================
use strict;
use warnings;
use Test::More tests => 6;
use Test::Output qw{ stderr_from };
use Getopt::Auto( { test => 1 } );
use 5.006;
our $VERSION = '1.9.7';
my $me = '03-options_text.t';
## no critic (ProhibitImplicitNewlines)
## no critic (ProtectPrivateSubs)
## no critic (RequireLocalizedPunctuationVars)
## no critic (ProtectPrivateVars)
## no critic (ProhibitPackageVars)
## no critic (ProhibitEmptyQuotes)
# Will be assigned by Getopt::Auto
our %options;
if ( %options ) {}; # Avoid complaints from perl-5.6.2
# What we expect to find in the spec list
my @exspec = (
[ '--bar', 'do a bar', undef, \&bar ],
[ '--foo', 'do a foo', 'Test long help for foo.
And this is the second paragraph for foo\'s help.
', \&foo
],
[ '--tar', '', undef, \&tar ],
);
# What we expect to find in the options hash
# This is the proof that --far is processed correctly:
# there is no option entry for it
my %ex_options = (
'--foo' => {
'longhelp' => 'Test long help for foo.
And this is the second paragraph for foo\'s help.
',
'code' => \&foo,
'shorthelp' => 'do a foo',
'options' => 'main::options',
'package' => 'main',
'registered' => 1,
},
'--bar' => {
'longhelp' => undef,
'code' => \&bar,
'shorthelp' => 'do a bar',
'options' => 'main::options',
'package' => 'main',
'registered' => 1,
},
'--tar' => {
'longhelp' => undef,
'code' => \&tar,
'shorthelp' => '',
'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,
},
);
my $is_foo_called;
sub foo { ++$is_foo_called; return; }
my $is_bar_called;
sub bar { ++$is_bar_called; return; }
my $is_tar_called;
sub tar { ++$is_tar_called; return; }
my $is_far_called;
sub far { ++$is_far_called; return; }
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' );
@ARGV = qw(--foo --bar --tar --far);
my $help =
"Getopt::Auto: --far is not a registered option\n" .
"This is $me version $VERSION\n" .
"\n" .
"$me --bar - do a bar\n" .
"$me --foo - do a foo [*]\n" .
"$me --help - This text\n" .
"$me --tar\n" .
"$me --version - Prints the version number\n" .
"\n" .
"More help is available on the topics marked with [*]\n" .
"Try $me --help --foo\n" .
"This is the built-in help, exiting\n";
my $stderr = stderr_from( \&Getopt::Auto::_parse_args );
$stderr =~ s{\S+$me}{$me}gxism;
is( $stderr, $help, '--far is not a registered option' );
ok( $is_foo_called, 'Sub foo() was called' );
ok( $is_bar_called, 'Sub bar() was called' );
ok( $is_tar_called, 'Sub tar() was called' );
exit 0;
__END__
=pod
=begin stopwords
foo
=end stopwords
=head2 --foo - do a foo
Test long help for foo.
And this is the second paragraph for foo's help.
=head2 --bar - do a bar
=head2 --tar -
=head2 --far -
=cut