t/109_help_flag.t

   1 #!/usr/bin/env perl
   2
   3 # The documentation claims:
   4 #   If Getopt::Long::Descriptive is installed and any of the following command
   5 #   line params are passed (--help, --usage, --?), the program will exit with
   6 #   usage information...
   7
   8 # This is not actually true (as of 0.29), as:
   9 # 1. the consuming class must set up a attributes named 'help', 'usage' and
  10 #     '?' to contain these command line options, which is not clearly
  11 #     documented as a requirement
  12 # 2.  the code is checking whether an option was parsed into an attribute
  13 #     *called* 'help', 'usage' or '?', not whether the option --help, --usage
  14 #     or --? was passed on the command-line (the mapping could be different,
  15 #     if cmd_flag or cmd_aliases is used),
  16
  17 # This inconsistency is the underlying cause of RT#52474, RT#57683, RT#47865.
  18
  19 use strict; use warnings;
  20 use Test::More tests => 6;
  21 use Test::Exception;
  22
  23 {
  24     package MyClass;
  25     use strict; use warnings;
  26     use Moose;
  27     with 'MooseX::Getopt';
  28 }
  29
  30 # before fix, prints this on stderr:
  31 #Unknown option: ?
  32 #usage: test1.t
  33
  34 # after fix, prints this on stderr:
  35 #usage: test1.t [-?] [long options...]
  36 #       -? --usage --help  Prints this usage information.
  37
  38 foreach my $args ( ['--help'], ['--usage'], ['--?'], ['-?'] )
  39 {
  40     local @ARGV = @$args;
  41
  42     throws_ok { MyClass->new_with_options() }
  43         qr/^usage: (?:[\d\w]+)\Q.t [-?] [long options...]\E.^\t\Q-? --usage --help  Prints this usage information.\E$/ms,
  44         'Help request detected; usage information properly printed';
  45 }
  46
  47 # now call again, and ensure we got the usage info.
  48 my $obj = MyClass->new_with_options();
  49 ok($obj->meta->has_attribute('usage'), 'class has usage attribute');
  50 isa_ok($obj->usage, 'Getopt::Long::Descriptive::Usage');
  51