X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Getopt.git;a=blobdiff_plain;f=t%2Fno_auto_help.t;fp=t%2Fno_auto_help.t;h=1afeffbd0686a3ffd671c484efd2eee5bff33e66;hp=0000000000000000000000000000000000000000;hb=8e026f54bc564a771c0bb59915175bcd9de9219e;hpb=2b4fef591e07a9c3e561da6162a8ed1d8c5cb3b7 diff --git a/t/no_auto_help.t b/t/no_auto_help.t new file mode 100644 index 0000000..1afeffb --- /dev/null +++ b/t/no_auto_help.t @@ -0,0 +1,54 @@ +# Related information: +# https://rt.cpan.org/Public/Bug/Display.html?id=47865 +# https://rt.cpan.org/Public/Bug/Display.html?id=52474 +# https://rt.cpan.org/Public/Bug/Display.html?id=57683 +# http://www.nntp.perl.org/group/perl.moose/2010/06/msg1767.html + +# Summary: If we disable the "auto_help" option in Getopt::Long, then +# getoptions() will not call into pod2usage() (causing program termination) +# when --help is passed. + + +my $fail_on_exit = 1; +{ + package Class; + use strict; use warnings; + + use Moose; + with + 'MooseX::SimpleConfig', + 'MooseX::Getopt'; + + # this is a hacky way of being able to check that we made it past the + # $opt_parser->getoptions() call in new_with_options, because it is + # still going to bail out later on, on seeing the --help flag + has configfile => ( + is => 'ro', isa => 'Str', + default => sub { + $fail_on_exit = 0; + 'this_value_unimportant', + }, + ); + + # only here to avoid an "unknown option: help" warning + has help => ( + is => 'ro', isa => 'Bool', + ); + + no Moose; + 1; +} + +use Test::More tests => 1; + +END { + ok(!$fail_on_exit, 'getoptions() lives'); + + # cancel the non-zero exit status from _getopt_full_usage() + exit 0; +} + + +@ARGV = ('--help'); +Class->new_with_options; +