From: Piotr Roszatycki <piotr.roszatycki@gmail.com>
Date: Wed, 12 Nov 2008 16:22:46 +0000 (+0000)
Subject: * MooseX::Getopt::Session: Drop die_on_warning attribute.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=19b87ede54eb20f76fafd42a944d56eb0f031dcb;p=gitmo%2FMooseX-Getopt.git

* MooseX::Getopt::Session: Drop die_on_warning attribute.
* MooseX::Getopt::Parser::Descriptive: Unmagle field names in options hashref.
* t/00[1234]*.t: Test both of parsers.
---

19b87ede54eb20f76fafd42a944d56eb0f031dcb
diff --cc ChangeLog
index 5cf2dd7,96b8290..75d2a43
--- a/ChangeLog
+++ b/ChangeLog
@@@ -12,15 -8,9 +12,14 @@@ Revision history for Perl extension Moo
          * MooseX::Getopt::Parser
          * MooseX::Getopt::Parser::Long
          * MooseX::Getopt::Parser::Descriptive
 -          - Handling with Getopt parser implemented as strategy pattern.
 +          - Getopt parser is pluggined.
              (dexter)
  
 +        * TODO:
-           - MooseX::Getopt::Parser::Descriptive is not implemeted yet.
 +          - MooseX::ConfigFromFile should be restored?
 +          - POD.
 +          - New test units.        
 +
  0.15 Sat. July 26 2008
  	* MooseX::Getopt::OptionTypeMap
  	  - Accept type constraint objects in the type mapping, not just names
diff --cc lib/MooseX/Getopt/Parser/Descriptive.pm
index 63e9744,bdcc26e..ad547ba
--- a/lib/MooseX/Getopt/Parser/Descriptive.pm
+++ b/lib/MooseX/Getopt/Parser/Descriptive.pm
@@@ -6,95 -6,46 +6,104 @@@ use Moose
  with 'MooseX::Getopt::Parser';
  
  use Getopt::Long::Descriptive;
 +use MooseX::Getopt::OptionTypeMap;
  
 -sub getoptions {
 -    my ($class, $opt_spec) = @_;
 -    return Getopt::Long::Descriptive::describe_options($class->_usage_format, @$opt_spec);
 -}
 +#use Smart::Comments;
  
 -sub _get_getopt_spec {
 -    my ($class, %params) = @_;
 +# Special configuration for parser
 +has 'config' => (
 +    is => 'rw',
 +    isa => 'ArrayRef[Str]',
 +    auto_deref => 1,
 +    default => sub { [] },
 +);
  
 -    my (@options, %name_to_init_arg );
 +# Format for usage description
 +has 'format' => (
 +    is => 'rw',
 +    isa => 'Str',
 +    default => 'usage: %c %o',
 +);
  
 -    my $constructor_params = $params{params};
  
 -    foreach my $opt ( @{ $params{options} } ) {
 -        push @options, [
 -            $opt->{opt_string},
 -            $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
 +sub build_options {
 +    my $self = shift;
 +    my ($getopt, @attrs) = @_;
 +
 +    Moose->throw_error('First argument is not a MooseX::Getopt::Session')
 +        unless $getopt->isa('MooseX::Getopt::Session');
 +
-     my ($options, $usage);
-     my @opts;
++    my $options = {};
++    my $usage;
++    my (@opts, %cmd_flags_to_names);
 +
 +    foreach my $attr (@attrs) {
 +        my $name = $attr->name;
 +
 +        my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
 +        my $type = $getopt->_get_cmd_type_for_attr($attr);
 +
++	$cmd_flags_to_names{$flag} = $name;
++
 +        my $opt_string = join '|', $flag, @aliases;
 +        $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type);
 +
 +        my $doc;
 +        $doc = $attr->documentation if $attr->has_documentation;
 +        $doc = ' ' unless $doc;
 +
 +        my $is_required = $attr->is_required && !$attr->has_default && !$attr->has_builder;
 +
 +        push @opts, [
 +            $opt_string => $doc,
              {
 -                ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
 -                # NOTE:
 -                # remove this 'feature' because it didn't work 
 -                # all the time, and so is better to not bother
 -                # since Moose will handle the defaults just 
 -                # fine anyway.
 -                # - SL
 -                #( exists $opt->{default}  ? (default  => $opt->{default})  : () ),
 -            },
 +                ( $is_required ? ( required => $attr->is_required ) : () ),
 +            }
          ];
 +    };
 +
 +    ### MooseX::Getopt::Parser::Descriptive::build_options @opts : @opts
 +
 +    GETOPT: {
 +        local @ARGV = $getopt->argv;
 +        ### MooseX::Getopt::Parser::Descriptive::build_options @ARGV : @ARGV
 +
 +        local $SIG{__WARN__} = sub {
 +            return warn @_ if $_[0]=~/^\###/;   # Smart::Comments
 +            $getopt->strcat_warning( $_[0] )
 +        };
 +
 +        eval {
 +            ($options, $usage) = Getopt::Long::Descriptive::describe_options(
 +                $self->format, @opts, { getopt_conf => [ $self->config ] }
 +            );
 +        };
 +        my $e = $@;
 +        $getopt->strcat_warning( $e ) if $e;
 +        $getopt->status( ! $e );
 +
 +        my $extra_argv = \@ARGV;
 +        $getopt->extra_argv( $extra_argv );
 +    };
 +
++    # Convert cmd_flags back to names in options hashref
++    $options = {
++        map {
++            $cmd_flags_to_names{$_} => $options->{$_}
++        } keys %$options,
++    };
++
 +    #%options = map { $_ => $options{$_} } grep { defined $options{$_} } keys %options;
-     $getopt->options( defined $options ? $options : {} );
++    $getopt->options( $options );
  
 -        my $identifier = $opt->{name};
 -        $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
 +    ### MooseX::Getopt::Parser::Descriptive::build_options $options : $options
 +    ### MooseX::Getopt::Parser::Descriptive::build_options $usage : $usage
 +    ### MooseX::Getopt::Parser::Descriptive::build_options $getopt->status : $getopt->status
  
-     die join '', $getopt->warning
-         if $getopt->die_on_warning && ($getopt->has_warning || !$getopt->status);
 -        $name_to_init_arg{$identifier} = $opt->{init_arg};
 -    }
++    die join '', $getopt->warning if ($getopt->has_warning || !$getopt->status);
  
 -    return ( \@options, \%name_to_init_arg );
 -}
 +    return $options;
 +};
  
 -sub _usage_format {
 -    return "usage: %c %o";
 -}
  
  1;
diff --cc lib/MooseX/Getopt/Parser/Long.pm
index 70ad5a1,e7fd7d3..12f6565
--- a/lib/MooseX/Getopt/Parser/Long.pm
+++ b/lib/MooseX/Getopt/Parser/Long.pm
@@@ -5,74 -5,31 +5,74 @@@ use Moose
  
  with 'MooseX::Getopt::Parser';
  
 -sub getoptions {
 -    my ($class, $opt_spec) = @_;
 +use Getopt::Long;
 +use MooseX::Getopt::OptionTypeMap;
 +
 +#use Smart::Comments;
 +
 +# Special configuration for parser
 +has 'config' => (
 +    is => 'rw',
 +    isa => 'ArrayRef[Str]',
 +    auto_deref => 1,
 +    default => sub { [] },
 +);
 +
 +
 +sub build_options {
 +    my $self = shift;
 +    my ($getopt, @attrs) = @_;
 +
 +    Moose->throw_error('First argument is not a MooseX::Getopt::Session')
 +        unless $getopt->isa('MooseX::Getopt::Session');
  
      my %options;
 +    my @opts;
 +
 +    foreach my $attr (@attrs) {
 +        my $name = $attr->name;
 +
 +        my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
 +        my $type = $getopt->_get_cmd_type_for_attr($attr);
 +
 +        my $opt_string = join '|', $flag, @aliases;
 +        $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type);
 +
 +        $options{$name} = undef;
 +        push @opts, $opt_string => \$options{$name};
 +    };
 +
 +    ### MooseX::Getopt::Parser::Long::build_options @opts : @opts
 +
 +    GETOPT: {
 +        my $parser = new Getopt::Long::Parser;
 +        $parser->configure( $self->config );
 +
 +        local @ARGV = $getopt->argv;
 +        ### MooseX::Getopt::Parser::Long::build_options @ARGV : @ARGV
  
 -    my $getopt = Getopt::Long::Parser->new;
 -    $getopt->getoptions(\%options, @$opt_spec);
 -    return ( \%options, undef );
 -}
 +        local $SIG{__WARN__} = sub {
 +            return warn @_ if $_[0]=~/^\###/;   # Smart::Comments
 +            my $warning = $getopt->has_warning ? $getopt->warning : '';
 +            $warning .= $_[0];
 +            $getopt->warning( $warning )
 +        };
  
 -sub _get_getopt_spec {
 -    my ($class, %params) = @_;
 +        my $status = $parser->getoptions( @opts );
 +        $getopt->status( $status );
  
 -    my ( @options, %name_to_init_arg, %options );
 +        my $extra_argv = \@ARGV;
 +        $getopt->extra_argv( $extra_argv );
 +    };
  
 -    foreach my $opt ( @{ $params{options} } ) {
 -        push @options, $opt->{opt_string};
 +    %options = map { $_ => $options{$_} } grep { defined $options{$_} } keys %options;
 +    $getopt->options( \%options );
  
-     die join '', $getopt->warning if $getopt->die_on_warning && $getopt->has_warning;
 -        my $identifier = $opt->{name};
 -        $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
++    die join '', $getopt->warning if $getopt->has_warning;
  
 -        $name_to_init_arg{$identifier} = $opt->{init_arg};
 -    }
 +    ### MooseX::Getopt::Parser::Long::build_options %options : %options
 +    return \%options;
 +};
  
 -    return ( \@options, \%name_to_init_arg );
 -}
  
  1;
diff --cc lib/MooseX/Getopt/Session.pm
index 0b10744,0000000..81f4b26
mode 100644,000000..100644
--- a/lib/MooseX/Getopt/Session.pm
+++ b/lib/MooseX/Getopt/Session.pm
@@@ -1,141 -1,0 +1,134 @@@
 +
 +package MooseX::Getopt::Session;
 +
 +use Moose;
 +
 +use MooseX::Getopt::Parser::Long;
 +use maybe 'MooseX::Getopt::Parser::Descriptive';
 +
 +#use Smart::Comments;
 +
 +# Pluggined MooseX::Getopt::Parser parser
- has 'getopt_parser' => (
++has 'parser' => (
 +    is => 'rw',
 +    does => 'MooseX::Getopt::Parser',
 +    default => sub {
 +        maybe::HAVE_MOOSEX_GETOPT_PARSER_DESCRIPTIVE
 +        ? MooseX::Getopt::Parser::Descriptive->new
 +        : MooseX::Getopt::Parser::Long->new
 +    },
 +);
 +
 +# Filter for classes which are searched for getopt trait
 +has 'classes_filter' => (
 +    is => 'rw',
 +    isa => 'CodeRef',
 +    default => sub { sub { 1 } },
 +);
 +
 +# Original @ARGV values
 +has 'argv' => (
 +    is => 'rw',
 +    isa => 'ArrayRef[Str]',
 +    auto_deref => 1,
 +    default => sub { [ @ARGV ] },
 +);
 +
 +# Unrecognized @ARGV values
 +has 'extra_argv' => (
 +    is => 'rw',
 +    isa => 'ArrayRef[Str]',
 +    auto_deref => 1,
 +    default => sub { [] },
 +);
 +
 +# Hash with options parsed from argv
 +has 'options' => (
 +    is => 'rw',
 +    isa => 'HashRef',
 +    auto_deref => 1,
 +    default => sub { {} },
 +);
 +
 +# Status of parser
 +has 'status' => (
 +    is => 'rw',
 +    isa => 'Bool',
 +);
 +
 +# Warnings collected by parser
 +has 'warning' => (
 +    is => 'rw',
 +    isa => 'Str',
 +    predicate => 'has_warning',
 +);
 +
 +# Die if warnings was occured
- has 'die_on_warning' => (
-     is => 'rw',
-     isa => 'Bool',
-     default => 1,
- );
- 
- 
 +sub BUILD {
 +    ### MooseX::Getopt::Session::BUILD : @_
 +    my ($self, $args) = @_;
 +
 +    $self->build_options;
 +};
 +
 +
 +sub build_options {
 +    my ($self) = @_;
 +
 +    my @attrs = map { $_->_compute_getopt_attrs } $self->_compute_getopt_classes;
 +    ### MooseX::Getopt::Session::build_options @attrs -> name : map { $_->name } @attrs
 +
-     return $self->getopt_parser->build_options( $self, @attrs );
++    return $self->parser->build_options( $self, @attrs );
 +}
 +
 +
 +sub _compute_getopt_classes {
 +    my $self = shift;
 +
 +    return grep {
 +        $self->classes_filter->()
 +    } grep {
 +        $_->isa('Moose::Object') && $_->does('MooseX::Getopt')
 +    } Class::MOP->get_all_metaclasses;
 +};
 +
 +
 +sub _get_cmd_flags_for_attr {
 +    my ($self, $attr) = @_;
 +
 +    my $flag = $attr->name;
 +
 +    my @aliases;
 +
 +    if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
 +        $flag = $attr->cmd_flag if $attr->has_cmd_flag;
 +        @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
 +    };
 +
 +    return ($flag, @aliases);
 +};
 +
 +
 +sub _get_cmd_type_for_attr {
 +    my ($self, $attr) = @_;
 +
 +    my $type;
 +    
 +    $type = $attr->type_constraint if $attr->has_type_constraint;
 +
 +    if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
 +        $type = $attr->cmd_type if $attr->has_cmd_type;
 +    };
 +
 +    return $type;
 +};
 +
 +
 +sub strcat_warning {
 +    my ($self, $string) = @_;
 +
 +    return $self->warning( ($self->has_warning ? $self->warning : '') . $string );
 +};
 +
 +
 +1;
diff --cc t/001_basic.t
index 6c1c1fa,6c1c1fa..3b171a1
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@@ -3,7 -3,7 +3,7 @@@
  use strict;
  use warnings;
  
--use Test::More tests => 69;
++use Test::More tests => 173;
  
  BEGIN {
      use_ok('MooseX::Getopt');
@@@ -12,11 -12,11 +12,11 @@@
  {
      package App;
      use Moose;
--    
++
      with 'MooseX::Getopt';
  
      has 'data' => (
--        metaclass => 'MooseX::Getopt::Meta::Attribute',        
++        metaclass => 'MooseX::Getopt::Meta::Attribute',
          is        => 'ro',
          isa       => 'Str',
          default   => 'file.dat',
@@@ -24,7 -24,7 +24,7 @@@
      );
  
      has 'cow' => (
--        metaclass   => 'Getopt',        
++        metaclass   => 'Getopt',
          is          => 'ro',
          isa         => 'Str',
          default     => 'moo',
@@@ -32,7 -32,7 +32,7 @@@
      );
  
      has 'horse' => (
--        metaclass   => 'MooseX::Getopt::Meta::Attribute',        
++        metaclass   => 'MooseX::Getopt::Meta::Attribute',
          is          => 'ro',
          isa         => 'Str',
          default     => 'bray',
@@@ -48,15 -48,15 +48,15 @@@
  
      has 'verbose' => (
          is     => 'ro',
--        isa    => 'Bool',       
++        isa    => 'Bool',
      );
--    
++
      has 'libs' => (
          is      => 'ro',
          isa     => 'ArrayRef',
          default => sub { [] },
--    ); 
--    
++    );
++
      has 'details' => (
          is      => 'ro',
          isa     => 'HashRef',
@@@ -70,13 -70,13 +70,13 @@@
      );
  
      has '_private_stuff_cmdline' => (
--        metaclass => 'MooseX::Getopt::Meta::Attribute',        
++        metaclass => 'MooseX::Getopt::Meta::Attribute',
          is        => 'ro',
          isa       => 'Int',
          default   => 832,
          cmd_flag  => 'p',
      );
--  
++
  }
  
  foreach my $attr_name (qw(data cow horse _private_stuff_cmdline)) {
@@@ -84,141 -84,141 +84,238 @@@
      isa_ok($attr, 'Moose::Meta::Attribute');
      isa_ok($attr, 'MooseX::Getopt::Meta::Attribute');
      can_ok($attr, 'cmd_flag');
--    can_ok($attr, 'cmd_aliases');    
++    can_ok($attr, 'cmd_aliases');
  }
  
--{
--    local @ARGV = ();
++foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser::Descriptive)) {
++    SKIP: {
++        if ($parser_name eq 'MooseX::Getopt::Parser::Descriptive') {
++            eval { require Getopt::Long::Descriptive };
++            skip "Getopt::Long::Descriptive not installed", 78 if $@;
++        }
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
++        {
++            local @ARGV = ();
  
--    ok(!$app->verbose, '... verbosity is off as expected');
--    is($app->length, 24, '... length is 24 as expected');    
--    is($app->data, 'file.dat', '... data is file.dat as expected');        
--    is_deeply($app->libs, [], '... libs is [] as expected'); 
--    is_deeply($app->details, {}, '... details is {} as expected');           
--}
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
  
--{
--    local @ARGV = ('--verbose', '--length', 50);
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
  
--    ok($app->verbose, '... verbosity is turned on as expected');
--    is($app->length, 50, '... length is 50 as expected');    
--    is($app->data, 'file.dat', '... data is file.dat as expected'); 
--    is_deeply($app->libs, [], '... libs is [] as expected');  
--    is_deeply($app->details, {}, '... details is {} as expected');                            
--}
++            ok(!$app->verbose, '... verbosity is off as expected');
++            is($app->length, 24, '... length is 24 as expected');
++            is($app->data, 'file.dat', '... data is file.dat as expected');
++            is_deeply($app->libs, [], '... libs is [] as expected');
++            is_deeply($app->details, {}, '... details is {} as expected');
++        }
  
--{
--    local @ARGV = ('--verbose', '-f', 'foo.txt');
++        {
++            local @ARGV = ('--verbose', '--length', 50);
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
  
--    ok($app->verbose, '... verbosity is turned on as expected');
--    is($app->length, 24, '... length is 24 as expected');    
--    is($app->data, 'foo.txt', '... data is foo.txt as expected'); 
--    is_deeply($app->libs, [], '... libs is [] as expected');    
--    is_deeply($app->details, {}, '... details is {} as expected');                             
--}
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
  
--{
--    local @ARGV = ('--verbose', '--libs', 'libs/', '--libs', 'includes/lib');
--
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--
--    ok($app->verbose, '... verbosity is turned on as expected');
--    is($app->length, 24, '... length is 24 as expected');    
--    is($app->data, 'file.dat', '... data is foo.txt as expected'); 
--    is_deeply($app->libs, 
--    ['libs/', 'includes/lib'], 
--    '... libs is [libs/, includes/lib] as expected');   
--    is_deeply($app->details, {}, '... details is {} as expected');                              
--}
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
  
--{
--    local @ARGV = ('--details', 'os=mac', '--details', 'name=foo');
--
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--
--    ok(!$app->verbose, '... verbosity is turned on as expected');
--    is($app->length, 24, '... length is 24 as expected');    
--    is($app->data, 'file.dat', '... data is foo.txt as expected'); 
--    is_deeply($app->libs, [], '... libs is [] as expected');    
--    is_deeply($app->details, 
--    { os => 'mac', name => 'foo' }, 
--    '... details is { os => mac, name => foo } as expected');                              
--}
++            ok($app->verbose, '... verbosity is turned on as expected');
++            is($app->length, 50, '... length is 50 as expected');
++            is($app->data, 'file.dat', '... data is file.dat as expected');
++            is_deeply($app->libs, [], '... libs is [] as expected');
++            is_deeply($app->details, {}, '... details is {} as expected');
++        }
  
--{
--    # Test negation on booleans too ...
--    local @ARGV = ('--noverbose');
++        {
++            local @ARGV = ('--verbose', '-f', 'foo.txt');
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
  
--    ok(!$app->verbose, '... verbosity is turned off as expected');
--    is($app->length, 24, '... length is 24 as expected');    
--    is($app->data, 'file.dat', '... file is file.dat as expected');   
--    is_deeply($app->libs, [], '... libs is [] as expected');                
--    is_deeply($app->details, {}, '... details is {} as expected');               
--}
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
  
--# Test cmd_alias without cmd_flag
--{
--    local @ARGV = ('--cow', '42');
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--    is($app->cow, 42, 'cmd_alias, but not using it');
--}
--{
--    local @ARGV = ('--moocow', '88');
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--    is($app->cow, 88, 'cmd_alias, using long one');
--}
--{
--    local @ARGV = ('-c', '99');
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--    is($app->cow, 99, 'cmd_alias, using short one');
--}
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
  
--# Test cmd_alias + cmd_flag
--{
--    local @ARGV = ('--horsey', '123');
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--    is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
--}
--{
--    local @ARGV = ('-x', '321');
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--    is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
--}
++            ok($app->verbose, '... verbosity is turned on as expected');
++            is($app->length, 24, '... length is 24 as expected');
++            is($app->data, 'foo.txt', '... data is foo.txt as expected');
  
--# Test _foo + cmd_flag
--{
--    local @ARGV = ('-p', '666');
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--    is($app->_private_stuff_cmdline, 666, '_foo + cmd_flag');
--}
++            is_deeply($app->libs, [], '... libs is [] as expected');
++            is_deeply($app->details, {}, '... details is {} as expected');
++        }
  
--# Test ARGV support
--{
--    my @args = ('-p', 12345, '-c', 99, '-');
--    local @ARGV = @args;
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--    is_deeply($app->ARGV, \@args, 'ARGV accessor');
--    is_deeply(\@ARGV, \@args, '@ARGV unmangled');
--    is_deeply($app->extra_argv, ['-'], 'extra_argv accessor');
++        {
++            local @ARGV = ('--verbose', '--libs', 'libs/', '--libs', 'includes/lib');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++
++            ok($app->verbose, '... verbosity is turned on as expected');
++            is($app->length, 24, '... length is 24 as expected');
++            is($app->data, 'file.dat', '... data is foo.txt as expected');
++            is_deeply($app->libs,
++            ['libs/', 'includes/lib'],
++            '... libs is [libs/, includes/lib] as expected');
++            is_deeply($app->details, {}, '... details is {} as expected');
++        }
++
++        {
++            local @ARGV = ('--details', 'os=mac', '--details', 'name=foo');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++
++            ok(!$app->verbose, '... verbosity is turned on as expected');
++            is($app->length, 24, '... length is 24 as expected');
++            is($app->data, 'file.dat', '... data is foo.txt as expected');
++            is_deeply($app->libs, [], '... libs is [] as expected');
++            is_deeply($app->details,
++            { os => 'mac', name => 'foo' },
++            '... details is { os => mac, name => foo } as expected');
++        }
++
++        {
++            # Test negation on booleans too ...
++            local @ARGV = ('--noverbose');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++
++            ok(!$app->verbose, '... verbosity is turned off as expected');
++            is($app->length, 24, '... length is 24 as expected');
++            is($app->data, 'file.dat', '... file is file.dat as expected');
++            is_deeply($app->libs, [], '... libs is [] as expected');
++            is_deeply($app->details, {}, '... details is {} as expected');
++        }
++
++        # Test cmd_alias without cmd_flag
++        {
++            local @ARGV = ('--cow', '42');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++            is($app->cow, 42, 'cmd_alias, but not using it');
++        }
++        {
++            local @ARGV = ('--moocow', '88');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++            is($app->cow, 88, 'cmd_alias, using long one');
++        }
++        {
++            local @ARGV = ('-c', '99');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++            is($app->cow, 99, 'cmd_alias, using short one');
++        }
++
++        # Test cmd_alias + cmd_flag
++        {
++            local @ARGV = ('--horsey', '123');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++            is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
++        }
++        {
++            local @ARGV = ('-x', '321');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++            is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
++        }
++
++        # Test _foo + cmd_flag
++        {
++            local @ARGV = ('-p', '666');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++            is($app->_private_stuff_cmdline, 666, '_foo + cmd_flag');
++        }
++
++        # Test ARGV support
++        {
++            my @args = ('-p', 12345, '-c', 99, '-');
++
++            local @ARGV = @args;
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++            is_deeply($app->ARGV, \@args, 'ARGV accessor');
++            is_deeply(\@ARGV, \@args, '@ARGV unmangled');
++            is_deeply($app->extra_argv, ['-'], 'extra_argv accessor');
++        }
++
++    }
  }
diff --cc t/002_custom_option_type.t
index fc46250,fc46250..3ccdc7e
--- a/t/002_custom_option_type.t
+++ b/t/002_custom_option_type.t
@@@ -3,7 -3,7 +3,7 @@@
  use strict;
  use warnings;
  
--use Test::More tests => 6;
++use Test::More tests => 21;
  
  BEGIN {
      use_ok('MooseX::Getopt');
@@@ -13,51 -13,51 +13,79 @@@
      package App;
      use Moose;
      use Moose::Util::TypeConstraints;
--    
++
      use Scalar::Util 'looks_like_number';
--    
++
      with 'MooseX::Getopt';
  
      subtype 'ArrayOfInts'
          => as 'ArrayRef'
          => where { scalar (grep { looks_like_number($_) } @$_)  };
--    
++
      MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
          'ArrayOfInts' => '=i@'
      );
--       
++
      has 'nums' => (
          is      => 'ro',
          isa     => 'ArrayOfInts',
          default => sub { [0] }
--    ); 
--  
++    );
++
  }
  
--{
--    local @ARGV = ();
++foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser::Descriptive)) {
++    SKIP: {
++        if ($parser_name eq 'MooseX::Getopt::Parser::Descriptive') {
++            eval { require Getopt::Long::Descriptive };
++            skip "Getopt::Long::Descriptive not installed", 10 if $@;
++        }
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--        
--    is_deeply($app->nums, [0], '... nums is [0] as expected');       
--}
++        {
++            local @ARGV = ();
  
--{
--    local @ARGV = ('--nums', 3, '--nums', 5);
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--        
--    is_deeply($app->nums, [3, 5], '... nums is [3, 5] as expected');       
--}
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
  
--# Make sure it really used our =i@, instead of falling back
--#  to =s@ via the type system, and test that exceptions work
--#  while we're at it.
--eval {
--    local @ARGV = ('--nums', 3, '--nums', 'foo');
++            is_deeply($app->nums, [0], '... nums is [0] as expected');
++        }
  
--    my $app = App->new_with_options;
--};
--like($@, qr/Value "foo" invalid/, 'Numeric constraint enforced');
++        {
++            local @ARGV = ('--nums', 3, '--nums', 5);
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++
++            is_deeply($app->nums, [3, 5], '... nums is [3, 5] as expected');
++        }
++
++        # Make sure it really used our =i@, instead of falling back
++        #  to =s@ via the type system, and test that exceptions work
++        #  while we're at it.
++        eval {
++            local @ARGV = ('--nums', 3, '--nums', 'foo');
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++        };
++        like($@, qr/Value "foo" invalid/, 'Numeric constraint enforced');
++
++    }
++}
diff --cc t/003_inferred_option_type.t
index 5624867,5624867..4581bc8
--- a/t/003_inferred_option_type.t
+++ b/t/003_inferred_option_type.t
@@@ -3,7 -3,7 +3,7 @@@
  use strict;
  use warnings;
  
--use Test::More tests => 5;
++use Test::More tests => 17;
  
  BEGIN {
      use_ok('MooseX::Getopt');
@@@ -13,38 -13,38 +13,59 @@@
      package App;
      use Moose;
      use Moose::Util::TypeConstraints;
--    
++
      use Scalar::Util 'looks_like_number';
--    
++
      with 'MooseX::Getopt';
  
      subtype 'ArrayOfInts'
          => as 'ArrayRef'
          => where { scalar (grep { looks_like_number($_) } @$_)  };
--    
++
      has 'nums' => (
          is      => 'ro',
          isa     => 'ArrayOfInts',
          default => sub { [0] }
--    ); 
--  
++    );
++
  }
  
--{
--    local @ARGV = ();
++foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser::Descriptive)) {
++    SKIP: {
++        if ($parser_name eq 'MooseX::Getopt::Parser::Descriptive') {
++            eval { require Getopt::Long::Descriptive };
++            skip "Getopt::Long::Descriptive not installed", 8 if $@;
++        }
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--        
--    is_deeply($app->nums, [0], '... nums is [0] as expected');       
--}
++        {
++            local @ARGV = ();
  
--{
--    local @ARGV = ('--nums', 3, '--nums', 5);
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
  
--    my $app = App->new_with_options;
--    isa_ok($app, 'App');
--        
--    is_deeply($app->nums, [3, 5], '... nums is [3, 5] as expected');       
--}
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
  
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++
++            is_deeply($app->nums, [0], '... nums is [0] as expected');
++        }
++
++        {
++            local @ARGV = ('--nums', 3, '--nums', 5);
++
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
++
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok($app, 'App');
++
++            is_deeply($app->nums, [3, 5], '... nums is [3, 5] as expected');
++        }
++
++    }
++}
diff --cc t/004_nogetop.t
index 78da66d,78da66d..c26006d
--- a/t/004_nogetop.t
+++ b/t/004_nogetop.t
@@@ -3,7 -3,7 +3,7 @@@
  use strict;
  use warnings;
  
--use Test::More tests => 9;
++use Test::More tests => 23;
  use Test::Exception;
  
  BEGIN {
@@@ -81,22 -81,22 +81,48 @@@
  
  }
  
--{
--    local @ARGV = ();
++foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser::Descriptive)) {
++    SKIP: {
++        if ($parser_name eq 'MooseX::Getopt::Parser::Descriptive') {
++            eval { require Getopt::Long::Descriptive };
++            skip "Getopt::Long::Descriptive not installed", 11 if $@;
++        }
  
--    my $app = App->new_with_options;
--    isa_ok( $app, 'App' );
++        {
++            local @ARGV = ();
  
--    ok( !$app->verbose, '... verbosity is off as expected' );
--    is( $app->length, 24,         '... length is 24 as expected' );
--    is( $app->data,   'file.dat', '... data is file.dat as expected' );
--    is_deeply( $app->libs, [], '... libs is [] as expected' );
--    is_deeply( $app->details, {}, '... details is {} as expected' );
--    is($app->private_stuff, 713, '... private stuff is 713 as expected');
--}
++            my $parser = $parser_name->new;
++            isa_ok($parser, $parser_name);
  
--{
--    local @ARGV = (qw/--private_stuff 317/);
++            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++            isa_ok($getopt, 'MooseX::Getopt::Session');
++
++            my $app = App->new_with_options( getopt => $getopt );
++            isa_ok( $app, 'App' );
++
++            ok( !$app->verbose, '... verbosity is off as expected' );
++            is( $app->length, 24,         '... length is 24 as expected' );
++            is( $app->data,   'file.dat', '... data is file.dat as expected' );
++            is_deeply( $app->libs, [], '... libs is [] as expected' );
++            is_deeply( $app->details, {}, '... details is {} as expected' );
++            is($app->private_stuff, 713, '... private stuff is 713 as expected');
++        }
++
++        {
++            local @ARGV = (qw/--private_stuff 317/);
++
++            throws_ok {
++
++                my $parser = $parser_name->new;
++                isa_ok($parser, $parser_name);
++
++                my $getopt = MooseX::Getopt::Session->new( parser => $parser );
++                isa_ok($getopt, 'MooseX::Getopt::Session');
++
++                App->new_with_options( getopt => $getopt )
++
++            } qr/Unknown option: private_stuff/;
++        }
  
--    throws_ok { App->new_with_options } qr/Unknown option: private_stuff/;
++    }
  }