From: Tomas Doran Date: Thu, 26 Nov 2009 22:02:20 +0000 (+0000) Subject: Update changes, tests for new hooks X-Git-Tag: 0.25~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b7f80a24b181933ad2cb3242f14b366b2d45ec1;p=gitmo%2FMooseX-Getopt.git Update changes, tests for new hooks --- diff --git a/ChangeLog b/ChangeLog index 147de7e..8ffb737 100644 --- a/ChangeLog +++ b/ChangeLog @@ -6,6 +6,7 @@ Revision history for Perl extension MooseX-Getopt overridden. - Split out calling ->die on Getopt::Long::Descriptive::Usage so that it can be overridden. + - Properly split roles as promised in 0.22. 0.24 Fri. Oct 23 2009 * MooseX::Getopt diff --git a/t/104_override_usage.t b/t/104_override_usage.t index be005bc..173c632 100644 --- a/t/104_override_usage.t +++ b/t/104_override_usage.t @@ -14,18 +14,44 @@ use Test::Exception; 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()) }; } { + local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception; local @ARGV = ('--foo', '1'); my $i = MyScript->new_with_options; ok $i; is $i->foo, 1; - is $MyScript::usage, 0; + is $MyScript::usage, undef; } { + local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception; local @ARGV = ('--help'); throws_ok { MyScript->new_with_options } qr/A foo/; is $MyScript::usage, 1; } +{ + local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception; + local @ARGV = ('-q'); # Does not exist + throws_ok { MyScript->new_with_options } qr/A foo/; + is_deeply \@MyScript::warnings, [ + 'Unknown option: q +' + ]; + my $exp = [ + 'Unknown option: q +', + qq{usage: 104_override_usage.t [long options...] +\t--help Help +\t--foo A foo +} + ]; + + is_deeply \@MyScript::exception, $exp; +} + done_testing;