X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F104_override_usage.t;h=517d8aa4323a5780e2c7b8f10977c22cef7ea68b;hb=83446b781bbe89f41f87f2c03f07065bda919f43;hp=be005bc13d016e24287a29be61fc3791ed28e15d;hpb=175b83f5692393946086f048dd8a0c1cdc28431b;p=gitmo%2FMooseX-Getopt.git diff --git a/t/104_override_usage.t b/t/104_override_usage.t index be005bc..517d8aa 100644 --- a/t/104_override_usage.t +++ b/t/104_override_usage.t @@ -1,7 +1,9 @@ use strict; use warnings; -use Test::More 0.88; -use Test::Exception; + +use Test::More tests => 6; +use Test::Trap; +use Test::NoWarnings 1.04 ':early'; { package MyScript; @@ -10,22 +12,47 @@ use Test::Exception; with 'MooseX::Getopt'; has foo => ( isa => 'Int', is => 'ro', documentation => 'A foo' ); - has help => ( isa => 'Bool', is => 'ro', default => 0, documentation => 'Help'); - - our $usage = 0; - before _getopt_full_usage => sub { $usage++; }; } + +# 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, 0; + my $i = trap { MyScript->new_with_options }; + is($i->foo, 1, 'attr is set'); + is($trap->stdout, '', 'nothing printed when option is accepted'); } + { local @ARGV = ('--help'); - throws_ok { MyScript->new_with_options } qr/A foo/; - is $MyScript::usage, 1; + trap { MyScript->new_with_options }; + is($trap->stdout, $usage, 'usage is printed on --help'); +} + +{ + local @ARGV = ('-q'); # Does not exist + trap { MyScript->new_with_options }; + is($trap->die, join("\n", 'Unknown option: q', $usage), 'usage is printed on unknown option'); +} + +{ + 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', + ); } -done_testing;