use strict;
use warnings;
-use Test::More 0.88;
-use Test::Exception;
+
+use Test::More tests => 7;
+use Test::Trap;
+use Test::NoWarnings 1.04 ':early';
{
package MyScript;
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 = <<USAGE;
+usage: 104_override_usage.t [-?h] [long options...]
+\t-h -? --usage --help Prints this usage information.
+\t--foo A foo
+USAGE
+
{
- 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, 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');
- 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 $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-? --usage --help Prints this usage information.
-\t--foo A foo
+ 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',
+ );
}
- ];
- is_deeply \@MyScript::exception, $exp;
+{
+ package MyScript2;
+ use Moose;
+
+ with 'MooseX::Getopt';
+ has foo => ( isa => 'Int', is => 'ro', documentation => 'A foo' );
}
-done_testing;
+{
+ # 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',
+ );
+}