t/postconfigure/01-options.t

   1 #! perl
   2 # Copyright (C) 2007, Parrot Foundation.
   3 # $Id$
   4 # 01-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 => 29;
  16 use Carp;
  17 use_ok(
  18     'Parrot::Configure::Options', qw|
  19         process_options
  20         |
  21 );
  22 use_ok(
  23     "Parrot::Configure::Options::Reconf", qw|
  24         @valid_options
  25         |
  26 );
  27 use IO::CaptureOutput qw | capture |;
  28
  29 my %valid;
  30 my $badoption = q{samsonanddelilah};
  31
  32 no warnings 'once';
  33 %valid = map { $_, 1 } @Parrot::Configure::Options::Reconf::valid_options;
  34 use warnings;
  35 ok( scalar keys %valid,          "non-zero quantity of valid options found" );
  36 ok( defined $valid{debugging},   "debugging option found" );
  37 ok( defined $valid{maintainer},  "maintainer option found" );
  38 ok( defined $valid{help},        "help option found" );
  39 ok( defined $valid{verbose},     "verbose option found" );
  40 ok( !defined $valid{$badoption}, "invalid option not found" );
  41
  42 my $args;
  43 $args = process_options(
  44     {
  45         argv => [],
  46         mode => q{reconfigure},
  47     }
  48 );
  49 ok( defined $args, "process_options() returned successfully" );
  50 ok( $args->{debugging}, "debugging turned on by default" );
  51
  52 eval { $args = process_options( { argv => [] } ); };
  53 like(
  54     $@,
  55     qr/'mode' argument not provided to process_options\(\)/,
  56     "process_options() failed due to lack of argument 'mode'"
  57 );
  58
  59 eval { $args = process_options( { argv => [], mode => 'foobar' } ); };
  60 like(
  61     $@,
  62     qr/Invalid value for 'mode' argument to process_options\(\)/,
  63     "process_options() failed due to invalid 'mode' argument"
  64 );
  65
  66 $args = process_options( { mode => q{reconfigure}, } );
  67 ok( defined $args,
  68     "process_options() returned successfully even though no explicit 'argv' key was provided" );
  69
  70 $args = process_options(
  71     {
  72         argv => [ q{--ask}, q{--verbose} ],
  73         mode => q{reconfigure},
  74     }
  75 );
  76 ok( defined $args, "process_options() returned successfully when options were specified" );
  77
  78 $args = process_options(
  79     {
  80         argv => [ q{--step=gen::makefiles}, q{--target=Makefile} ],
  81         mode => q{reconfigure},
  82     }
  83 );
  84 ok( defined $args,
  85     "With 'reconfigure' mode, 'step' and 'target' are valid options to process_options()" );
  86
  87 $badoption = q{cc};
  88 my $CC = "/usr/bin/gcc-3.3";
  89 eval { $args = process_options( { argv => [qq{--$badoption=$CC}], mode => q{reconfigure}, } ); };
  90 like(
  91     $@,
  92     qr/^Invalid option "$badoption"/,
  93     "process_options() failed due to bad option '$badoption'"
  94 );
  95
  96 {
  97     my ($rv, $stdout);
  98     capture(
  99         sub { $args = process_options(
 100                 { argv => [q{--help}], mode => q{reconfigure}, }
 101             ); },
 102         \$stdout,
 103     );
 104     ok( !defined $args, "process_options() returned undef after 'help' option" );
 105     like( $stdout, qr/--help/i, "got correct message after 'help' option" );
 106 }
 107
 108 {
 109     my ($rv, $stdout);
 110     capture(
 111         sub { $args = process_options(
 112                 { argv => [q{--}], mode => q{reconfigure}, }
 113             ); },
 114         \$stdout,
 115     );
 116     like( $stdout, qr/--help/i, "got help message as expected" );
 117 }
 118
 119 $badoption = q{version};
 120 eval { $args = process_options( { argv => [qq{--$badoption}], mode => q{reconfigure}, } ); };
 121 like(
 122     $@,
 123     qr/^Invalid option "$badoption"/,
 124     "process_options() failed due to bad option '$badoption'"
 125 );
 126
 127 $args = process_options(
 128     {
 129         argv => [ q{--lex}, ],
 130         mode => q{reconfigure},
 131     }
 132 );
 133 ok( defined $args, "process_options() returned successfully after 'lex' option" );
 134 ok( $args->{maintainer}, "'maintainer' attribute is true after 'lex' option" );
 135
 136 $args = process_options(
 137     {
 138         argv => [ q{--yacc}, ],
 139         mode => q{reconfigure},
 140     }
 141 );
 142 ok( defined $args, "process_options() returned successfully after 'yacc' option" );
 143 ok( $args->{maintainer}, "'maintainer' attribute is true after 'yacc' option" );
 144
 145 $args = process_options(
 146     {
 147         argv => [q{--debugging=1}],
 148         mode => q{reconfigure},
 149     }
 150 );
 151 ok( defined $args, "process_options() returned successfully" );
 152 ok( $args->{debugging}, "debugging turned on explicitly" );
 153
 154 $args = process_options(
 155     {
 156         argv => [q{--debugging=0}],
 157         mode => q{reconfigure},
 158     }
 159 );
 160 ok( defined $args, "process_options() returned successfully" );
 161 ok( !$args->{debugging}, "debugging explicitly turned off" );
 162
 163 pass("Completed all tests in $0");
 164
 165 ################### DOCUMENTATION ###################
 166
 167 =head1 NAME
 168
 169 01-options.t - test Parrot::Configure::Options as used in F<tools/dev/reconfigure.pl>
 170
 171 =head1 SYNOPSIS
 172
 173     % prove t/postconfigure/01-options.t
 174
 175 =head1 DESCRIPTION
 176
 177 The files in this directory test functionality used after initial
 178 configuration.
 179
 180 The tests in this file test subroutines exported by Parrot::Configure::Options
 181 as it is used in F<tools/dev/reconfigure.pl>, I<i.e.>, with C<mode =>
 182 reconfigure>.
 183
 184 =head1 AUTHOR
 185
 186 James E Keenan
 187
 188 =head1 SEE ALSO
 189
 190 Parrot::Configure::Options, Parrot::Configure::Options::Reconf, F<Configure.pl>.
 191
 192 =cut
 193
 194 # Local Variables:
 195 #   mode: cperl
 196 #   cperl-indent-level: 4
 197 #   fill-column: 100
 198 # End:
 199 # vim: expandtab shiftwidth=4: