t/configure/001-options.t

   1 #! perl
   2 # Copyright (C) 2007, Parrot Foundation.
   3 # $Id$
   4 # 001-options.t
   5
   6 use strict;
   7 use warnings;
   8
   9 BEGIN {
  10     use FindBin qw($Bin);
  11     use Cwd qw(cwd realpath);
  12     our $topdir = realpath($Bin) . "/../..";
  13     unshift @INC, qq{$topdir/lib};
  14 }
  15 use Test::More tests => 51;
  16 use Carp;
  17 use Parrot::Configure::Options qw| process_options |;
  18 use Parrot::Configure::Options::Conf::CLI ();
  19 use Parrot::Configure::Options::Conf::File ();
  20 use Parrot::Configure::Options::Reconf ();
  21 use IO::CaptureOutput qw| capture |;
  22
  23 my %valid;
  24 my $badoption = q{samsonanddelilah};
  25
  26 no warnings 'once';
  27 %valid = map { $_, 1 } @Parrot::Configure::Options::Conf::CLI::valid_options;
  28 use warnings;
  29 ok( scalar keys %valid,          "non-zero quantity of valid options found" );
  30 ok( defined $valid{debugging},   "debugging option found" );
  31 ok( defined $valid{maintainer},  "maintainer option found" );
  32 ok( defined $valid{help},        "help option found" );
  33 ok( defined $valid{version},     "version option found" );
  34 ok( defined $valid{verbose},     "verbose option found" );
  35 ok( !defined $valid{$badoption}, "invalid option not found" );
  36 ok( !defined $valid{step},       "invalid 'step' option not found" );
  37 ok( !defined $valid{target},     "invalid 'target' option not found" );
  38
  39 open my $FH, '<', "$main::topdir/Configure.pl"
  40     or croak "Unable to open handle to $main::topdir/Configure.pl:  $!";
  41 my $bigstr;
  42 {
  43     local $/ = undef;
  44     $bigstr = <$FH>;
  45 }
  46 close $FH or croak "Unable to close handle to Configure.pl:  $!";
  47
  48 # Ignore any POD I have moved to an __END__ block.
  49 $bigstr =~ s/__END__.*//s;
  50 my ( @lines, @possible_methods );
  51 @lines = grep { /^=item/ } ( split /\n/, $bigstr );
  52 foreach my $l (@lines) {
  53     my $method;
  54     if ( $l =~ /^=item C<--([-_\w]+)(?:[=>])/ ) {
  55         $method = $1;
  56         push @possible_methods, $method;
  57     }
  58 }
  59 my $invalid = 0;
  60 foreach my $m (@possible_methods) {
  61     unless ( defined $valid{$m} ) {
  62         carp "Possibly invalid method: $m";
  63         $invalid++;
  64     }
  65 }
  66 ok( !$invalid, "No invalid methods described in POD" );
  67
  68 my ($args, $step_list_ref);
  69 ($args, $step_list_ref) = process_options(
  70     {
  71         argv => [],
  72         mode => q{configure},
  73     }
  74 );
  75 ok( defined $args, "process_options() returned successfully" );
  76 ok( $args->{debugging}, "debugging turned on by default" );
  77
  78 eval { ($args, $step_list_ref) = process_options( { argv => [] } ); };
  79 like(
  80     $@,
  81     qr/'mode' argument not provided to process_options\(\)/,
  82     "process_options() failed due to lack of argument 'mode'"
  83 );
  84
  85 eval { ($args, $step_list_ref) = process_options( { argv => [], mode => 'foobar' } ); };
  86 like(
  87     $@,
  88     qr/Invalid value for 'mode' argument to process_options\(\)/,
  89     "process_options() failed due to invalid 'mode' argument"
  90 );
  91
  92 ($args, $step_list_ref) = process_options(
  93     {
  94         mode => q{configure},
  95         ,
  96     }
  97 );
  98 ok( defined $args,
  99     "process_options() returned successfully even though no explicit 'argv' key was provided" );
 100
 101 my $CC = "/usr/bin/gcc-3.3";
 102 my $CX = "/usr/bin/g++-3.3";
 103 ($args, $step_list_ref) = process_options(
 104     {
 105         argv => [
 106             q{--cc=$CC},      q{--cxx=$CX}, q{--link=$CX}, q{--ld=$CX},
 107             q{--without-icu}, q{--without-gmp},
 108         ],
 109         mode => q{configure},
 110     }
 111 );
 112 ok( defined $args,
 113     "process_options() returned successfully when options were specified" );
 114
 115 eval { ($args, $step_list_ref) = process_options( { argv => [qq<--${badoption}=72>], mode => q{configure}, } ); };
 116 like(
 117     $@,
 118     qr/^Invalid option.*$badoption/,
 119     "process_options() failed due to bad option '$badoption'"
 120 );
 121
 122 $badoption = q{step};
 123 eval { ($args, $step_list_ref) = process_options( { argv => [qq<--${badoption}>], mode => q{configure}, } ); };
 124 like(
 125     $@,
 126     qr/^Invalid option.*$badoption/,
 127     "process_options() failed due to bad option '$badoption'"
 128 );
 129
 130 $badoption = q{target};
 131 eval { ($args, $step_list_ref) = process_options( { argv => [qq<--${badoption}>], mode => q{configure}, } ); };
 132 like(
 133     $@,
 134     qr/^Invalid option.*$badoption/,
 135     "process_options() failed due to bad option '$badoption'"
 136 );
 137
 138 {
 139     my $stdout;
 140     $args = capture( sub { process_options(
 141         {
 142             argv => [q{--help}],
 143             mode => q{configure},
 144         }
 145     ) } , \$stdout);
 146     ok( !defined $args,
 147         "process_options() returned undef after 'help' option" );
 148     like( $stdout, qr/--help/i, "got correct message after 'help' option" );
 149 }
 150
 151 {
 152     my $stdout;
 153     $args = capture( sub { process_options(
 154         {
 155             argv => [q{--}],
 156             mode => q{configure},
 157         }
 158     ) } , \$stdout);
 159     ok( !defined $args,
 160         "process_options() returned undef after '--' option triggered help message" );
 161     like( $stdout, qr/--help/i, "got help message as expected" );
 162 }
 163
 164 {
 165     my $stdout;
 166     $args = capture( sub { process_options(
 167         {
 168             argv => [q{--version}],
 169             mode => q{configure},
 170         }
 171     ) } , \$stdout);
 172     ok( !defined $args,
 173         "process_options() returned undef after 'version' option" );
 174     like( $stdout, qr/Parrot Version/i,
 175         "got correct message after 'version' option" );
 176 }
 177
 178 ($args, $step_list_ref) = process_options(
 179     {
 180         argv => [ q{--lex}, ],
 181         mode => q{configure},
 182     }
 183 );
 184 ok( defined $args,
 185     "process_options() returned successfully after 'lex' option" );
 186 ok( $args->{maintainer}, "'maintainer' attribute is true after 'lex' option" );
 187
 188 ($args, $step_list_ref) = process_options(
 189     {
 190         argv => [ q{--yacc}, ],
 191         mode => q{configure},
 192     }
 193 );
 194 ok( defined $args,
 195     "process_options() returned successfully after 'yacc' option" );
 196 ok( $args->{maintainer}, "'maintainer' attribute is true after 'yacc' option" );
 197
 198 ($args, $step_list_ref) = process_options(
 199     {
 200         argv => [q{--debugging=1}],
 201         mode => q{configure},
 202     }
 203 );
 204 ok( defined $args, "process_options() returned successfully" );
 205 ok( $args->{debugging}, "debugging turned on explicitly" );
 206
 207 ($args, $step_list_ref) = process_options(
 208     {
 209         argv => [q{--debugging=0}],
 210         mode => q{configure},
 211     }
 212 );
 213 ok( defined $args, "process_options() returned successfully" );
 214 ok( !$args->{debugging}, "debugging explicitly turned off" );
 215
 216 ######### Parrot::Configure::Options internal subroutines #########
 217
 218 my ($options_components, $script);
 219
 220 $args = { argv => [], mode => 'configure' };
 221 ($args, $options_components, $script) =
 222     Parrot::Configure::Options::_process_options_components($args);
 223 is_deeply($args->{argv}, [], "Got expected value for 'argv' element");
 224 is_deeply($options_components,
 225     { %Parrot::Configure::Options::Conf::CLI::options_components },
 226     "Got expected value for options components");
 227 is($script, q{Configure.pl}, "Got expected value for script");
 228
 229 $args = { argv => [], mode => 'reconfigure' };
 230 ($args, $options_components, $script) =
 231     Parrot::Configure::Options::_process_options_components($args);
 232 is_deeply($args->{argv}, [], "Got expected value for 'argv' element");
 233 is_deeply($options_components,
 234     { %Parrot::Configure::Options::Reconf::options_components },
 235     "Got expected value for options components");
 236 is($script, q{tools/dev/reconfigure.pl}, "Got expected value for script");
 237
 238 $args = { argv => [], mode => 'file' };
 239 ($args, $options_components, $script) =
 240     Parrot::Configure::Options::_process_options_components($args);
 241 is_deeply($args->{argv}, [], "Got expected value for 'argv' element");
 242 is_deeply($options_components,
 243     { %Parrot::Configure::Options::Conf::File::options_components },
 244     "Got expected value for options components");
 245 is($script, q{Configure.pl}, "Got expected value for script");
 246
 247 my $cc = q{/usr/bin/gcc};
 248 $args = {
 249     argv => [ q{--verbose}, q{--help}, qq{--cc=$cc} ],
 250     mode => 'configure',
 251 };
 252 ($args, $options_components, $script) =
 253     Parrot::Configure::Options::_process_options_components($args);
 254 my ($data, $short_circuits_ref) =
 255     Parrot::Configure::Options::_initial_pass(
 256         $args, $options_components, $script);
 257 is($data->{verbose}, 1, "Got expected value for verbose");
 258 is($data->{help}, 1, "Got expected value for help");
 259 is($data->{cc}, $cc, "Got expected value for cc");
 260 is_deeply($short_circuits_ref, [ q{help} ],
 261     "Got expected short circuits");
 262
 263 $args = {
 264     argv => [ q{--verbose}, qq{--cc=$cc} ],
 265     mode => 'configure',
 266 };
 267 ($args, $options_components, $script) =
 268     Parrot::Configure::Options::_process_options_components($args);
 269 ($data, $short_circuits_ref) =
 270     Parrot::Configure::Options::_initial_pass(
 271         $args, $options_components, $script);
 272 is($data->{verbose}, 1, "Got expected value for verbose");
 273 ok(! defined $data->{help}, "Got expected value for help");
 274 is($data->{cc}, $cc, "Got expected value for cc");
 275 is_deeply($short_circuits_ref, [ ],
 276     "Got expected short circuits");
 277
 278 pass("Completed all tests in $0");
 279
 280 ################### DOCUMENTATION ###################
 281
 282 =head1 NAME
 283
 284 001-options.t - test Parrot::Configure::Options as used in Configure.pl
 285
 286 =head1 SYNOPSIS
 287
 288     % prove t/configure/001-options.t
 289
 290 =head1 DESCRIPTION
 291
 292 The files in this directory test functionality used by F<Configure.pl>.
 293
 294 The tests in this file test subroutines exported by
 295 Parrot::Configure::Options as it is used in F<Configure.pl>, I<i.e.>, with
 296 C<mode =E<gt> q{configure}>.
 297
 298 =head1 AUTHOR
 299
 300 James E Keenan
 301
 302 =head1 SEE ALSO
 303
 304 Parrot::Configure::Options, Parrot::Configure::Options::Conf,
 305 Parrot::Configure::Options::Conf::CLI, F<Configure.pl>.
 306
 307 =cut
 308
 309 # Local Variables:
 310 #   mode: cperl
 311 #   cperl-indent-level: 4
 312 #   fill-column: 100
 313 # End:
 314 # vim: expandtab shiftwidth=4: