X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F104_override_usage.t;h=091b47bbfafaeaec0c08380cb8bbd95c385af042;hb=aec092482d5b90b8279e4a5f92165868a78ddf32;hp=173c632c932bfb8bf420d7bf0595ab6f71b81952;hpb=9b7f80a24b181933ad2cb3242f14b366b2d45ec1;p=gitmo%2FMooseX-Getopt.git

diff --git a/t/104_override_usage.t b/t/104_override_usage.t
index 173c632..091b47b 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 warnings FATAL => 'all';
+
+use Test::More tests => 7;
+use Test::Trap;
+use Test::NoWarnings 1.04 ':early';
 
 {
     package MyScript;
@@ -10,48 +12,74 @@ 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++; };
-    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--help     Help
-\t--foo      A foo
+    trap { MyScript->new_with_options };
+    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',
+    );
 }
 
-done_testing;
+{
+    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',
+    );
+}