t/006_metaclass_traits.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 291;
   7 use Test::Moose;
   8
   9 BEGIN {
  10     use_ok('MooseX::Getopt');
  11 }
  12
  13 {
  14     package App;
  15     use Moose;
  16
  17     with 'MooseX::Getopt';
  18
  19     has 'data' => (
  20         traits    => [ 'MooseX::Getopt::Meta::Attribute::Trait' ],
  21         is        => 'ro',
  22         isa       => 'Str',
  23         default   => 'file.dat',
  24         cmd_flag  => 'f',
  25     );
  26
  27     has 'cow' => (
  28         traits      => [ 'Getopt' ],
  29         is          => 'ro',
  30         isa         => 'Str',
  31         default     => 'moo',
  32         cmd_aliases => [qw/ moocow m c /],
  33     );
  34
  35     has 'horse' => (
  36         traits      => [ 'Getopt' ],
  37         is          => 'ro',
  38         isa         => 'Str',
  39         default     => 'bray',
  40         cmd_flag    => 'horsey',
  41         cmd_aliases => 'x',
  42     );
  43
  44     has 'guinea_pig' => (
  45         traits      => [ 'Getopt' ],
  46         is          => 'ro',
  47         isa         => 'Str',
  48         default     => 'squeak',
  49         cmd_flag    => 'guinea-pig',
  50         cmd_aliases => [qw/ cavia-porcellus /],
  51     );
  52
  53     has 'length' => (
  54         is      => 'ro',
  55         isa     => 'Int',
  56         default => 24
  57     );
  58
  59     has 'verbose' => (
  60         is     => 'ro',
  61         isa    => 'Bool',
  62     );
  63
  64     has 'libs' => (
  65         is      => 'ro',
  66         isa     => 'ArrayRef',
  67         default => sub { [] },
  68     );
  69
  70     has 'details' => (
  71         is      => 'ro',
  72         isa     => 'HashRef',
  73         default => sub { {} },
  74     );
  75
  76     has '_private_stuff' => (
  77         is      => 'ro',
  78         isa     => 'Int',
  79         default => 713
  80     );
  81
  82     has '_private_stuff_cmdline' => (
  83         traits    => [ 'Getopt' ],
  84         is        => 'ro',
  85         isa       => 'Int',
  86         default   => 832,
  87         cmd_flag  => 'p',
  88     );
  89
  90 }
  91
  92 foreach my $attr_name (qw(data cow horse guinea_pig _private_stuff_cmdline)) {
  93     my $attr = App->meta->get_attribute($attr_name);
  94     isa_ok($attr, 'Moose::Meta::Attribute');
  95     does_ok($attr, 'MooseX::Getopt::Meta::Attribute::Trait');
  96
  97     can_ok($attr, 'cmd_flag');
  98     can_ok($attr, 'cmd_aliases');
  99 }
 100
 101 foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser::Descriptive MooseX::Getopt::Parser::Default)) {
 102     SKIP: {
 103         if ($parser_name eq 'MooseX::Getopt::Parser::Descriptive') {
 104             eval { require Getopt::Long::Descriptive };
 105             skip "Getopt::Long::Descriptive not installed", 90 if $@;
 106         }
 107
 108         {
 109             local @ARGV = ();
 110
 111             my $parser = $parser_name->new;
 112             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 113
 114             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 115             isa_ok($getopt, 'MooseX::Getopt::Session');
 116
 117             my $app = App->new_with_options( getopt => $getopt );
 118             isa_ok($app, 'App');
 119
 120             ok(!$app->verbose, '... verbosity is off as expected');
 121             is($app->length, 24, '... length is 24 as expected');
 122             is($app->data, 'file.dat', '... data is file.dat as expected');
 123             is_deeply($app->libs, [], '... libs is [] as expected');
 124             is_deeply($app->details, {}, '... details is {} as expected');
 125         }
 126
 127         {
 128             local @ARGV = ('--verbose', '--length', 50);
 129
 130             my $parser = $parser_name->new;
 131             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 132
 133             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 134             isa_ok($getopt, 'MooseX::Getopt::Session');
 135
 136             my $app = App->new_with_options( getopt => $getopt );
 137             isa_ok($app, 'App');
 138
 139             ok($app->verbose, '... verbosity is turned on as expected');
 140             is($app->length, 50, '... length is 50 as expected');
 141             is($app->data, 'file.dat', '... data is file.dat as expected');
 142             is_deeply($app->libs, [], '... libs is [] as expected');
 143             is_deeply($app->details, {}, '... details is {} as expected');
 144         }
 145
 146         {
 147             local @ARGV = ('--verbose', '-f', 'foo.txt');
 148
 149             my $parser = $parser_name->new;
 150             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 151
 152             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 153             isa_ok($getopt, 'MooseX::Getopt::Session');
 154
 155             my $app = App->new_with_options( getopt => $getopt );
 156             isa_ok($app, 'App');
 157
 158             ok($app->verbose, '... verbosity is turned on as expected');
 159             is($app->length, 24, '... length is 24 as expected');
 160             is($app->data, 'foo.txt', '... data is foo.txt as expected');
 161             is_deeply($app->libs, [], '... libs is [] as expected');
 162             is_deeply($app->details, {}, '... details is {} as expected');
 163         }
 164
 165         {
 166             local @ARGV = ('--verbose', '--libs', 'libs/', '--libs', 'includes/lib');
 167
 168             my $parser = $parser_name->new;
 169             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 170
 171             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 172             isa_ok($getopt, 'MooseX::Getopt::Session');
 173
 174             my $app = App->new_with_options( getopt => $getopt );
 175             isa_ok($app, 'App');
 176
 177             ok($app->verbose, '... verbosity is turned on as expected');
 178             is($app->length, 24, '... length is 24 as expected');
 179             is($app->data, 'file.dat', '... data is foo.txt as expected');
 180             is_deeply($app->libs,
 181             ['libs/', 'includes/lib'],
 182             '... libs is [libs/, includes/lib] as expected');
 183             is_deeply($app->details, {}, '... details is {} as expected');
 184         }
 185
 186         {
 187             local @ARGV = ('--details', 'os=mac', '--details', 'name=foo');
 188
 189             my $parser = $parser_name->new;
 190             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 191
 192             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 193             isa_ok($getopt, 'MooseX::Getopt::Session');
 194
 195             my $app = App->new_with_options( getopt => $getopt );
 196             isa_ok($app, 'App');
 197
 198             ok(!$app->verbose, '... verbosity is turned on as expected');
 199             is($app->length, 24, '... length is 24 as expected');
 200             is($app->data, 'file.dat', '... data is foo.txt as expected');
 201             is_deeply($app->libs, [], '... libs is [] as expected');
 202             is_deeply($app->details,
 203             { os => 'mac', name => 'foo' },
 204             '... details is { os => mac, name => foo } as expected');
 205         }
 206
 207         {
 208             # Test negation on booleans too ...
 209             local @ARGV = ('--noverbose');
 210
 211             my $parser = $parser_name->new;
 212             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 213
 214             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 215             isa_ok($getopt, 'MooseX::Getopt::Session');
 216
 217             my $app = App->new_with_options( getopt => $getopt );
 218             isa_ok($app, 'App');
 219
 220             ok(!$app->verbose, '... verbosity is turned off as expected');
 221             is($app->length, 24, '... length is 24 as expected');
 222             is($app->data, 'file.dat', '... file is file.dat as expected');
 223             is_deeply($app->libs, [], '... libs is [] as expected');
 224             is_deeply($app->details, {}, '... details is {} as expected');
 225         }
 226
 227         # Test cmd_alias without cmd_flag
 228         {
 229             local @ARGV = ('--cow', '42');
 230
 231             my $parser = $parser_name->new;
 232             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 233
 234             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 235             isa_ok($getopt, 'MooseX::Getopt::Session');
 236
 237             my $app = App->new_with_options( getopt => $getopt );
 238             isa_ok($app, 'App');
 239             is($app->cow, 42, 'cmd_alias, but not using it');
 240         }
 241         {
 242             local @ARGV = ('--moocow', '88');
 243
 244             my $parser = $parser_name->new;
 245             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 246
 247             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 248             isa_ok($getopt, 'MooseX::Getopt::Session');
 249
 250             my $app = App->new_with_options( getopt => $getopt );
 251             isa_ok($app, 'App');
 252             is($app->cow, 88, 'cmd_alias, using long one');
 253         }
 254         {
 255             local @ARGV = ('-c', '99');
 256
 257             my $parser = $parser_name->new;
 258             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 259
 260             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 261             isa_ok($getopt, 'MooseX::Getopt::Session');
 262
 263             my $app = App->new_with_options( getopt => $getopt );
 264             isa_ok($app, 'App');
 265             is($app->cow, 99, 'cmd_alias, using short one');
 266         }
 267
 268         # Test cmd_alias + cmd_flag
 269         {
 270             local @ARGV = ('--horsey', '123');
 271
 272             my $parser = $parser_name->new;
 273             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 274
 275             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 276             isa_ok($getopt, 'MooseX::Getopt::Session');
 277
 278             my $app = App->new_with_options( getopt => $getopt );
 279             isa_ok($app, 'App');
 280             is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
 281         }
 282         {
 283             local @ARGV = ('-x', '321');
 284
 285             my $parser = $parser_name->new;
 286             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 287
 288             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 289             isa_ok($getopt, 'MooseX::Getopt::Session');
 290
 291             my $app = App->new_with_options( getopt => $getopt );
 292             isa_ok($app, 'App');
 293             is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
 294         }
 295
 296         # Test cmd_alias + cmd_flag with hyphen
 297         {
 298             local @ARGV = ();
 299
 300             my $parser = $parser_name->new;
 301             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 302
 303             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 304             isa_ok($getopt, 'MooseX::Getopt::Session');
 305
 306             my $app = App->new_with_options( getopt => $getopt );
 307             isa_ok($app, 'App');
 308             is($app->guinea_pig, 'squeak', 'cmd_alias+cmd_flag with hyphen, using default');
 309         }
 310         {
 311             local @ARGV = ('guinea-pig', 'babe');
 312
 313             my $parser = $parser_name->new;
 314             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 315
 316             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 317             isa_ok($getopt, 'MooseX::Getopt::Session');
 318
 319             my $app = App->new_with_options( getopt => $getopt );
 320             isa_ok($app, 'App');
 321             is($app->guinea_pig, 'squeak', 'cmd_alias+cmd_flag with hyphen, using flag');
 322         }
 323         {
 324             local @ARGV = ('--cavia-porcellus', 'babe');
 325
 326             my $parser = $parser_name->new;
 327             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 328
 329             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 330             isa_ok($getopt, 'MooseX::Getopt::Session');
 331
 332             my $app = App->new_with_options( getopt => $getopt );
 333             isa_ok($app, 'App');
 334             is($app->guinea_pig, 'babe', 'cmd_alias+cmd_flag with hyphen, using alias');
 335         }
 336
 337         # Test _foo + cmd_flag
 338         {
 339             local @ARGV = ('-p', '666');
 340
 341             my $parser = $parser_name->new;
 342             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 343
 344             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 345             isa_ok($getopt, 'MooseX::Getopt::Session');
 346
 347             my $app = App->new_with_options( getopt => $getopt );
 348             isa_ok($app, 'App');
 349             is($app->_private_stuff_cmdline, 666, '_foo + cmd_flag');
 350         }
 351
 352         # Test ARGV support
 353         {
 354             my @args = ('-p', 12345, '-c', 99, '-');
 355             local @ARGV = @args;
 356
 357             my $parser = $parser_name->new;
 358             ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
 359
 360             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 361             isa_ok($getopt, 'MooseX::Getopt::Session');
 362
 363             my $app = App->new_with_options( getopt => $getopt );
 364             isa_ok($app, 'App');
 365             is_deeply($app->ARGV, \@args, 'ARGV accessor');
 366             is_deeply(\@ARGV, \@args, '@ARGV unmangled');
 367             is_deeply($app->extra_argv, ['-'], 'extra_argv accessor');
 368         }
 369
 370     }
 371 }