Author: jkeenan
Date: Wed Aug 6 18:29:26 2008
New Revision: 30075
Added:
branches/scriptconfigure/t/configure/062-options_conf_file.t
- copied, changed from r30044,
/branches/scriptconfigure/t/configure/025-options_test.t
Modified:
branches/scriptconfigure/MANIFEST
branches/scriptconfigure/lib/Parrot/Configure/Options.pm
branches/scriptconfigure/t/configure/001-options.t
Log:
[configure] Refactor code from within
Parrot::Configure::Options::process_options() into more testable internal
subroutines _process_options_components() and _initial_pass(). Add tests for
these subs in t/configure/001-options.t.
Modified: branches/scriptconfigure/MANIFEST
==============================================================================
--- branches/scriptconfigure/MANIFEST (original)
+++ branches/scriptconfigure/MANIFEST Wed Aug 6 18:29:26 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Aug 6 02:47:31 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Aug 7 01:27:36 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -3331,6 +3331,7 @@
t/configure/059-silent.t []
t/configure/060-silent.t []
t/configure/061-revision_from_cache.t []
+t/configure/062-options_conf_file.t []
t/configure/testlib/Make_VERSION_File.pm []
t/configure/testlib/Tie/Filehandle/Preempt/Stdin.pm []
t/configure/testlib/init/alpha.pm []
Modified: branches/scriptconfigure/lib/Parrot/Configure/Options.pm
==============================================================================
--- branches/scriptconfigure/lib/Parrot/Configure/Options.pm (original)
+++ branches/scriptconfigure/lib/Parrot/Configure/Options.pm Wed Aug 6
18:29:26 2008
@@ -19,17 +19,51 @@
sub process_options {
my $argsref = shift;
- my %options_components;
croak "'mode' argument not provided to process_options()"
unless defined $argsref->{mode};
+
+ my ($options_components, $script);
+ ($argsref, $options_components, $script) =
+ _process_options_components($argsref);
+
+ my ($data, $short_circuits_seen_ref) =
+ _initial_pass($argsref, $options_components, $script);
+
+ if (@{ $short_circuits_seen_ref }) {
+ # run all the short circuits
+ foreach my $sc (@{ $short_circuits_seen_ref }) {
+ &{ $options_components->{short_circuits}{$sc} };
+ }
+ return;
+ }
+ else {
+ if ($argsref->{mode} eq 'file' or $argsref->{mode} eq 'configure') {
+ my $steps_list_ref;
+ ($data, $steps_list_ref) =
+ &{ $options_components->{conditionals} }($data);
+ return ($data, $steps_list_ref);
+ }
+ else {
+ $data = &{ $options_components->{conditionals} }($data);
+ return $data;
+ }
+ }
+}
+
+sub _process_options_components {
+ my $argsref = shift;
+ my %options_components;
if ( $argsref->{mode} =~ m/^reconfigure$/i ) {
- %options_components =
%Parrot::Configure::Options::Reconf::options_components;
+ %options_components =
+ %Parrot::Configure::Options::Reconf::options_components;
}
elsif ( $argsref->{mode} =~ m/^file$/i ) {
- %options_components =
%Parrot::Configure::Options::Conf::File::options_components;
+ %options_components =
+ %Parrot::Configure::Options::Conf::File::options_components;
}
elsif ( $argsref->{mode} =~ m/^configure$/i ) {
- %options_components =
%Parrot::Configure::Options::Conf::CLI::options_components;
+ %options_components =
+ %Parrot::Configure::Options::Conf::CLI::options_components;
}
else {
croak "Invalid value for 'mode' argument to process_options()";
@@ -40,9 +74,14 @@
$options_components{script}
? $options_components{script}
: croak "Must provide value for 'script'";
+ return ($argsref, \%options_components, $script);
+}
- my %valid_opts = map { $_, 1 } @{
$options_components{valid_options} };
- my $data = {};
+sub _initial_pass {
+ my ($argsref, $options_components, $script) = @_;
+ my %valid_opts =
+ map { $_, 1 } @{ $options_components->{valid_options} };
+ my $data = {};
my @short_circuits_seen = ();
for my $el ( @{ $argsref->{argv} } ) {
my ( $key, $value );
@@ -55,31 +94,12 @@
unless ( $valid_opts{$key} ) {
die qq/Invalid option "$key". See "perl $script --help" for valid
options\n/;
}
- if ( $options_components{short_circuits}{$key} ) {
+ if ( $options_components->{short_circuits}{$key} ) {
push @short_circuits_seen, $key;
}
$data->{$key} = $value;
}
- if (@short_circuits_seen) {
-
- # run all the short circuits
- foreach my $sc (@short_circuits_seen) {
- &{ $options_components{short_circuits}{$sc} };
- }
- return;
- }
- else {
- if ($argsref->{mode} eq 'file' or $argsref->{mode} eq 'configure') {
- my $steps_list_ref;
- ($data, $steps_list_ref) =
- &{ $options_components{conditionals} }($data);
- return ($data, $steps_list_ref);
- }
- else {
- $data = &{ $options_components{conditionals} }($data);
- return $data;
- }
- }
+ return ($data, [EMAIL PROTECTED]);
}
1;
Modified: branches/scriptconfigure/t/configure/001-options.t
==============================================================================
--- branches/scriptconfigure/t/configure/001-options.t (original)
+++ branches/scriptconfigure/t/configure/001-options.t Wed Aug 6 18:29:26 2008
@@ -12,10 +12,12 @@
our $topdir = realpath($Bin) . "/../..";
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests => 34;
+use Test::More qw(no_plan); # tests => 34;
use Carp;
use Parrot::Configure::Options qw| process_options |;
-use Parrot::Configure::Options::Conf::CLI qw| @valid_options |;
+use Parrot::Configure::Options::Conf::CLI ();
+use Parrot::Configure::Options::Conf::File ();
+use Parrot::Configure::Options::Reconf ();
use IO::CaptureOutput qw| capture |;
my %valid;
@@ -107,7 +109,8 @@
mode => q{configure},
}
);
-ok( defined $args, "process_options() returned successfully when options were
specified" );
+ok( defined $args,
+ "process_options() returned successfully when options were specified" );
eval { ($args, $step_list_ref) = process_options( { argv =>
[qq<--${badoption}=72>], mode => q{configure}, } ); };
like(
@@ -140,7 +143,8 @@
mode => q{configure},
}
) } , \$stdout);
- ok( !defined $args, "process_options() returned undef after 'help' option"
);
+ ok( !defined $args,
+ "process_options() returned undef after 'help' option" );
like( $stdout, qr/--help/i, "got correct message after 'help' option" );
}
@@ -165,8 +169,10 @@
mode => q{configure},
}
) } , \$stdout);
- ok( !defined $args, "process_options() returned undef after 'version'
option" );
- like( $stdout, qr/Parrot Version/i, "got correct message after 'version'
option" );
+ ok( !defined $args,
+ "process_options() returned undef after 'version' option" );
+ like( $stdout, qr/Parrot Version/i,
+ "got correct message after 'version' option" );
}
($args, $step_list_ref) = process_options(
@@ -175,7 +181,8 @@
mode => q{configure},
}
);
-ok( defined $args, "process_options() returned successfully after 'lex'
option" );
+ok( defined $args,
+ "process_options() returned successfully after 'lex' option" );
ok( $args->{maintainer}, "'maintainer' attribute is true after 'lex' option" );
($args, $step_list_ref) = process_options(
@@ -184,7 +191,8 @@
mode => q{configure},
}
);
-ok( defined $args, "process_options() returned successfully after 'yacc'
option" );
+ok( defined $args,
+ "process_options() returned successfully after 'yacc' option" );
ok( $args->{maintainer}, "'maintainer' attribute is true after 'yacc' option"
);
($args, $step_list_ref) = process_options(
@@ -205,6 +213,68 @@
ok( defined $args, "process_options() returned successfully" );
ok( !$args->{debugging}, "debugging explicitly turned off" );
+######### Parrot::Configure::Options internal subroutines #########
+
+my ($options_components, $script);
+
+$args = { argv => [], mode => 'configure' };
+($args, $options_components, $script) =
+ Parrot::Configure::Options::_process_options_components($args);
+is_deeply($args->{argv}, [], "Got expected value for 'argv' element");
+is_deeply($options_components,
+ { %Parrot::Configure::Options::Conf::CLI::options_components },
+ "Got expected value for options components");
+is($script, q{Configure.pl}, "Got expected value for script");
+
+$args = { argv => [], mode => 'reconfigure' };
+($args, $options_components, $script) =
+ Parrot::Configure::Options::_process_options_components($args);
+is_deeply($args->{argv}, [], "Got expected value for 'argv' element");
+is_deeply($options_components,
+ { %Parrot::Configure::Options::Reconf::options_components },
+ "Got expected value for options components");
+is($script, q{tools/dev/reconfigure.pl}, "Got expected value for script");
+
+$args = { argv => [], mode => 'file' };
+($args, $options_components, $script) =
+ Parrot::Configure::Options::_process_options_components($args);
+is_deeply($args->{argv}, [], "Got expected value for 'argv' element");
+is_deeply($options_components,
+ { %Parrot::Configure::Options::Conf::File::options_components },
+ "Got expected value for options components");
+is($script, q{Configure.pl}, "Got expected value for script");
+
+my $cc = q{/usr/bin/gcc};
+$args = {
+ argv => [ q{--verbose}, q{--help}, qq{--cc=$cc} ],
+ mode => 'configure',
+};
+($args, $options_components, $script) =
+ Parrot::Configure::Options::_process_options_components($args);
+my ($data, $short_circuits_ref) =
+ Parrot::Configure::Options::_initial_pass(
+ $args, $options_components, $script);
+is($data->{verbose}, 1, "Got expected value for verbose");
+is($data->{help}, 1, "Got expected value for help");
+is($data->{cc}, $cc, "Got expected value for cc");
+is_deeply($short_circuits_ref, [ q{help} ],
+ "Got expected short circuits");
+
+$args = {
+ argv => [ q{--verbose}, qq{--cc=$cc} ],
+ mode => 'configure',
+};
+($args, $options_components, $script) =
+ Parrot::Configure::Options::_process_options_components($args);
+my ($data, $short_circuits_ref) =
+ Parrot::Configure::Options::_initial_pass(
+ $args, $options_components, $script);
+is($data->{verbose}, 1, "Got expected value for verbose");
+ok(! defined $data->{help}, "Got expected value for help");
+is($data->{cc}, $cc, "Got expected value for cc");
+is_deeply($short_circuits_ref, [ ],
+ "Got expected short circuits");
+
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
Copied: branches/scriptconfigure/t/configure/062-options_conf_file.t (from
r30044, /branches/scriptconfigure/t/configure/025-options_test.t)
==============================================================================
--- /branches/scriptconfigure/t/configure/025-options_test.t (original)
+++ branches/scriptconfigure/t/configure/062-options_conf_file.t Wed Aug
6 18:29:26 2008
@@ -1,90 +1,25 @@
#! perl
# Copyright (C) 2007, The Perl Foundation.
# $Id$
-# 025-options_test.t
+# 062-options_conf_file.t
use strict;
use warnings;
-use Carp;
-use Cwd;
-use Data::Dumper;
-use File::Temp qw( tempdir );
-use Test::More tests => 9;
-#use Test::More qw( no_plan );
+use Test::More qw(no_plan); # tests => 9;
+#use Carp;
+#use Cwd;
+#use Data::Dumper;
+#use File::Temp qw( tempdir );
use lib qw( lib );
-use IO::CaptureOutput qw| capture |;
-use_ok(
- 'Parrot::Configure::Options', qw|
- process_options
- |
+use Parrot::Configure::Options::Conf::File qw(
+ @valid_options
+ $script
+ %options_components
+ $parrot_version
+ $svnid
);
-use_ok('Parrot::Configure::Options::Test');
+#use IO::CaptureOutput qw| capture |;
-my ( $args, $step_list_ref ) = process_options(
- {
- argv => [q{--test}],
- mode => q{configure},
- }
-);
-ok( defined $args,
- "process_options() returned successfully when options were specified" );
-
-my $opttest = Parrot::Configure::Options::Test->new($args);
-ok( defined $opttest, "Constructor returned successfully" );
-
-# Running the actual pre- and post-configuration tests would be too
-# time-consuming. So instead, we want to redefine the lists of tests to be
-# run to include only dummy test files found in temporary directories.
-
-my $cwd = cwd();
-
-my $teststring = <<"TEST";
-use Test::More tests => 1;
-{
- pass("Dummy test passed");
-}
-TEST
-
-{
- my $tdir = tempdir( CLEANUP => 1 );
- ok( ( chdir $tdir ), "Changed to temporary directory for testing" );
- my $test = q{testfile};
- open my $T, ">", $test
- or die "Unable to open dummy test file for writing";
- print $T $teststring;
- close $T or die "Unable to close dummy test file after writing";
-
- no warnings 'once';
-
- my $reason = q{Devel::Cover gags on this test};
-
- {
- my ($rv, $stdout);
- SKIP: {
- skip $reason, 1 if $ENV{PERL5OPT};
- capture (
- sub { $rv = $opttest->run_configure_tests($test); },
- \$stdout
- );
- ok( $rv, "Configuration tests are runnable" );
- }
- }
-
- {
- my ($rv, $stdout);
- SKIP: {
- skip $reason, 1 if $ENV{PERL5OPT};
- capture (
- sub { $rv = $opttest->run_build_tests($test); },
- \$stdout
- );
- ok( $rv, "Build tests are runnable" );
- }
- }
- unlink $test or croak "Unable to delete $test";
-
- ok( ( chdir $cwd ), "Changed back to starting directory after testing" );
-}
pass("Completed all tests in $0");
@@ -92,17 +27,18 @@
=head1 NAME
-025-options_test.t - test Parrot::Configure::Options::Test
+062-options_conf_file.t - test Parrot::Configure::Options::Test
=head1 SYNOPSIS
- % prove t/configure/025-options_test.t
+ % prove t/configure/062-options_conf_file.t
=head1 DESCRIPTION
The files in this directory test functionality used by F<Configure.pl>.
-The tests in this file test Parrot::Configure::Options::Test methods.
+The tests in this file test Parrot::Configure::Options::Conf::File
+subroutines.
=head1 AUTHOR
@@ -110,7 +46,8 @@
=head1 SEE ALSO
-Parrot::Configure::Options, F<Configure.pl>.
+Parrot::Configure::Options, Parrot::Configure::Options::Conf::File,
+F<Configure.pl>.
=cut
