X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F104_override_usage.t;h=8fa9299aeb69973eebe07f831ea936baa28c251f;hb=0cdc0384ddb0c3be31312270a986ef74c77db300;hp=3f0da19f5d9a7ee6949947fc30638a44ec7fd20a;hpb=9fbb5be9dcf64475fb6f4d25807db1e952be2365;p=gitmo%2FMooseX-Getopt.git diff --git a/t/104_override_usage.t b/t/104_override_usage.t index 3f0da19..8fa9299 100644 --- a/t/104_override_usage.t +++ b/t/104_override_usage.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 7; use Test::Trap; use Test::NoWarnings 1.04 ':early'; @@ -12,48 +12,74 @@ use Test::NoWarnings 1.04 ':early'; with 'MooseX::Getopt'; has foo => ( isa => 'Int', is => 'ro', documentation => 'A foo' ); - - our $usage = 0; - before _getopt_full_usage => sub { $usage++; }; - our @warnings; - before _getopt_spec_warnings => sub { shift; push(@warnings, @_) }; - our @exception; - before _getopt_spec_exception => sub { shift; push(@exception, @{ shift() }, shift()) }; } + +# FIXME - it looks like we have a spacing issue in Getopt::Long? +my $usage = <new_with_options; - ok $i; - is $i->foo, 1; - is $MyScript::usage, undef; + my $i = trap { MyScript->new_with_options }; + is($i->foo, 1, 'attr is set'); + is($trap->stdout, '', 'nothing printed when option is accepted'); } + { - local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception; local @ARGV = ('--help'); trap { MyScript->new_with_options }; - like($trap->stdout, qr/A foo/); - is $MyScript::usage, 1; + is($trap->stdout, $usage, 'usage is printed on --help'); } + { - local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception; local @ARGV = ('-q'); # Does not exist trap { MyScript->new_with_options }; - like($trap->die, qr/A foo/); - is_deeply \@MyScript::warnings, [ - 'Unknown option: q -' - ]; - # FIXME - it looks like we have a spacing issue in Getopt::Long? - my $exp = [ - 'Unknown option: q -', - qq{usage: 104_override_usage.t [-?h] [long options...] -\t-h -? --usage --help Prints this usage information. -\t--foo A foo + is($trap->die, join("\n", 'Unknown option: q', $usage), 'usage is printed on unknown option'); } - ]; - is_deeply \@MyScript::exception, $exp; +{ + Class::MOP::class_of('MyScript')->add_before_method_modifier( + print_usage_text => sub { + print "--- DOCUMENTATION ---\n"; + }, + ); + + local @ARGV = ('--help'); + trap { MyScript->new_with_options }; + is( + $trap->stdout, + join("\n", '--- DOCUMENTATION ---', $usage), + 'additional text included before normal usage string', + ); +} + +{ + package MyScript2; + use Moose; + + with 'MooseX::Getopt'; + has foo => ( isa => 'Int', is => 'ro', documentation => 'A foo' ); +} + +{ + # some classes (e.g. ether's darkpan and Catalyst::Runtime) overrode + # _getopt_full_usage, so we need to keep it in the call stack so we don't + # break them. + Class::MOP::class_of('MyScript2')->add_before_method_modifier( + _getopt_full_usage => sub { + print "--- DOCUMENTATION ---\n"; + }, + ); + + local @ARGV = ('--help'); + trap { MyScript2->new_with_options }; + is( + $trap->stdout, + join("\n", '--- DOCUMENTATION ---', $usage), + 'additional text included before normal usage string', + ); }