Permalink
Browse files

Refactor preparatory code found in lib/Parrot/Configure/Options/Test.…

…pm into

lib/Parrot/Configure/Options/Test/Prepare.pm.  carp instead of dying silently
when config step class lacks corresponding test files (incorporating Geoffrey
Broadwell's patch in http://rt.perl.org/rt3/Ticket/Display.html?id=53034).
Make changes needed in Configure.pl, t/configure/025-options_test.t and
t/configure/026-options_test.t.  Add t/configure/049-options_test.t to test
previously untested branches and regexes.


git-svn-id: https://svn.parrot.org/parrot/trunk@27036 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent 1270e09 commit a725b2fcef4a423b5dfed3ed85f4dd86772bb79a @jkeenan jkeenan committed Apr 19, 2008
View
@@ -11,6 +11,10 @@
use Parrot::Configure;
use Parrot::Configure::Options qw( process_options );
use Parrot::Configure::Options::Test;
+use Parrot::Configure::Options::Test::Prepare qw(
+ get_preconfiguration_tests
+ get_postconfiguration_tests
+);
use Parrot::Configure::Messages qw(
print_introduction
print_conclusion
@@ -41,7 +45,7 @@
# configuration tests will only be run if you requested them
# as command-line option
-$opttest->run_configure_tests();
+$opttest->run_configure_tests( get_preconfiguration_tests() );
my $parrot_version = $Parrot::Configure::Options::Conf::parrot_version;
@@ -63,7 +67,7 @@
# build tests will only be run if you requested them
# as command-line option
-$opttest->run_build_tests();
+$opttest->run_build_tests( get_postconfiguration_tests() );
my $make = $conf->data->get('make');
# from Parrot::Configure::Messages
View
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Apr 19 12:09:40 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat Apr 19 14:35:57 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2451,6 +2451,7 @@ lib/Parrot/Configure/Options.pm [devel]
lib/Parrot/Configure/Options/Conf.pm [devel]
lib/Parrot/Configure/Options/Reconf.pm [devel]
lib/Parrot/Configure/Options/Test.pm [devel]
+lib/Parrot/Configure/Options/Test/Prepare.pm [devel]
lib/Parrot/Configure/Step.pm [devel]
lib/Parrot/Configure/Step/List.pm [devel]
lib/Parrot/Configure/Step/Methods.pm [devel]
@@ -3077,6 +3078,7 @@ t/configure/045-generated_file_header.t []
t/configure/046-inter.t []
t/configure/047-inter.t []
t/configure/048-return_result_undef.t []
+t/configure/049-options_ttest.t []
t/configure/050-fatal.t []
t/configure/051-fatal_step.t []
t/configure/052-fatal_step.t []
@@ -8,54 +8,6 @@ use Test::Harness;
use lib qw(lib);
use Parrot::Configure::Step::List qw( get_steps_list );
-my @framework_tests;
-my $config_dir = q{t/configure};
-opendir my $DIRH, $config_dir or croak "Unable to open $config_dir";
-for my $t (sort grep { /\d{3}-\w+\.t$/ } readdir $DIRH) {
- push @framework_tests, qq{$config_dir/$t};
-}
-closedir $DIRH or croak "Unable to close $config_dir";
-
-my $steps_dir = q{t/steps};
-my %steps_tests;
-my @steps_tests;
-opendir my $DIRH2, $steps_dir or croak "Unable to open $steps_dir";
-for my $t (grep { /\.t$/ } readdir $DIRH2) {
- my ($type, $class, $num);
- if ($t =~ m/(init|inter|auto|gen)_(\w+)-(\d{2})\.t$/) {
- ($type, $class, $num) = ($1,$2,$3);
- $steps_tests{$type}{$class}{$num}++;
- }
- else {
- carp "Unable to match $t";
- }
-}
-closedir $DIRH2 or croak "Unable to close $steps_dir";
-
-my @steps = get_steps_list();
-
-foreach my $step (@steps) {
- my @temp = split /::/, $step;
- my %these_tests = %{ $steps_tests{$temp[0]}{$temp[1]} };
- foreach my $k (sort keys %these_tests) {
- push @steps_tests, qq{$steps_dir/$temp[0]_$temp[1]-$k.t};
- }
-}
-
-our @preconfiguration_tests = (
- @framework_tests,
- @steps_tests,
-);
-
-our @postconfiguration_tests = (
- glob("t/postconfigure/*.t"),
- glob("t/tools/pmc2cutils/*.t"),
- glob("t/tools/ops2cutils/*.t"),
- glob("t/tools/ops2pmutils/*.t"),
- glob("t/tools/revision/*.t"),
- glob("t/pharness/*.t"),
-);
-
sub new {
my ( $class, $argsref ) = @_;
my $self = {};
@@ -129,9 +81,9 @@ sub get_run {
return $self->{run}{$option} || undef;
}
-
sub run_configure_tests {
my $self = shift;
+ my @preconfiguration_tests = @_;
if ( $self->get_run('run_configure_tests') ) {
print "As you requested, we'll start with some tests of the configuration tools.\n\n";
@@ -149,6 +101,7 @@ TEST
sub run_build_tests {
my $self = shift;
+ my @postconfiguration_tests = @_;
if ( $self->get_run('run_build_tests') ) {
print "\n\n";
print "As you requested, I will now run some tests of the build tools.\n\n";
@@ -172,6 +125,10 @@ In F<Configure.pl>:
use Parrot::Configure::Options;
use Parrot::Configure::Options::Test;
+ use Parrot::Configure::Options::Test::Prepare qw(
+ get_preconfiguration_tests
+ get_postconfiguration_tests
+ );
$args = process_options( {
argv => [ @ARGV ],
@@ -180,9 +137,9 @@ In F<Configure.pl>:
$opttest = Parrot::Configure::Options::Test->new($args);
- $opttest->run_configure_tests();
+ $opttest->run_configure_tests( get_preconfiguration_tests() );
- $opttest->run_build_tests();
+ $opttest->run_build_tests( get_postconfiguration_tests() );
On command line:
@@ -245,19 +202,13 @@ Run tests of Parrot's configuration tools.
=item * Arguments
-None.
+List of test files, typically supplied by
+C<Parrot::Configure::Options::Test::Prepare::get_preconfiguration_tests()>.
=item * Return Value
None.
-=item * Comments
-
-The tests to be executed are listed in
-C<@Parrot::Configure::Options::Test::preconfiguration_tests>. Edit that list
-to run different tests. Currently, that array runs all tests in
-F<t/configure/*.t>.
-
=back
=head2 C<run_build_tests()>
@@ -272,23 +223,13 @@ F<Configure.pl> has completed execution.
=item * Arguments
-None.
+List of test files, typically supplied by
+C<Parrot::Configure::Options::Test::Prepare::get_postconfiguration_tests()>.
=item * Return Value
None.
-=item * Comments
-
-The tests to be executed are listed in
-C<@Parrot::Configure::Options::Test::postconfiguration_tests>. Edit that list
-to run different tests. Currently, that array runs all tests in:
-
- t/postconfigure/*.t
- t/tools/pmc2cutils/*.t
- t/tools/ops2cutils/*.t
- t/tools/ops2pmutils/*.t
-
=back
=head1 AUTHOR
@@ -0,0 +1,160 @@
+# Copyright (C) 2001-2006, The Perl Foundation.
+# $Id$
+package Parrot::Configure::Options::Test::Prepare;
+use strict;
+use warnings;
+use Carp;
+use base qw( Exporter );
+our @EXPORT_OK = qw(
+ get_preconfiguration_tests
+ get_postconfiguration_tests
+);
+use lib qw(lib);
+use Parrot::Configure::Step::List qw( get_steps_list );
+
+my $config_dir = q{t/configure};
+my @framework_tests = _get_framework_tests($config_dir);
+
+my $steps_dir = q{t/steps};
+my $steps_tests_ref = _get_steps_tests($steps_dir);
+my @steps_expected = get_steps_list();
+my @steps_tests = _prepare_steps_tests_list(
+ $steps_dir,
+ $steps_tests_ref,
+ \@steps_expected,
+);
+
+sub get_preconfiguration_tests {
+ return ( @framework_tests, @steps_tests );
+};
+
+sub get_postconfiguration_tests {
+ my @postconfiguration_tests = (
+ glob("t/postconfigure/*.t"),
+ glob("t/tools/pmc2cutils/*.t"),
+ glob("t/tools/ops2cutils/*.t"),
+ glob("t/tools/ops2pmutils/*.t"),
+ glob("t/pharness/*.t"),
+ );
+ return @postconfiguration_tests;
+};
+
+########## INTERNAL SUBROUTINES ##########
+
+sub _get_framework_tests {
+ my $config_dir = shift;
+ my @framework_tests;
+ opendir my $DIRH, $config_dir or croak "Unable to open $config_dir";
+ for my $t (sort grep { /\d{3}-\w+\.t$/ } readdir $DIRH) {
+ push @framework_tests, qq{$config_dir/$t};
+ }
+ closedir $DIRH or croak "Unable to close $config_dir";
+ return @framework_tests;
+}
+
+sub _get_steps_tests {
+ my $steps_dir = shift;
+ my %steps_tests = ();
+ opendir my $DIRH2, $steps_dir or croak "Unable to open $steps_dir";
+ for my $t (grep { /\.t$/ } readdir $DIRH2) {
+ my ($type, $class, $num);
+ if ($t =~ m/(init|inter|auto|gen)_(\w+)-(\d{2})\.t$/) {
+ ($type, $class, $num) = ($1,$2,$3);
+ $steps_tests{$type}{$class}{$num}++;
+ }
+ else {
+ carp "Unable to match $t";
+ }
+ }
+ closedir $DIRH2 or croak "Unable to close $steps_dir";
+ return \%steps_tests;
+}
+
+sub _prepare_steps_tests_list {
+ my $steps_dir = shift;
+ my $steps_tests_ref = shift;
+ my $steps_expected_ref = shift;
+ my %steps_tests = %{ $steps_tests_ref };
+ my @steps_tests;
+ foreach my $step ( @{ $steps_expected_ref } ) {
+ my @temp = split /::/, $step;
+ my $these_tests = $steps_tests{$temp[0]}{$temp[1]}
+ or carp "No tests exist for configure step $step";
+ foreach my $k (sort keys %$these_tests) {
+ push @steps_tests, qq{$steps_dir/$temp[0]_$temp[1]-$k.t};
+ }
+ }
+ return @steps_tests;
+}
+
+1;
+
+#################### DOCUMENTATION ####################
+
+=head1 NAME
+
+Parrot::Configure::Options::Test::Prepare
+
+=head1 ABSTRACT
+
+Prepare the lists of tests run before and after configuration when C<--test>
+option is provided to F<Configure.pl>.
+
+=head1 SYNOPSIS
+
+In F<Configure.pl>:
+
+ use Parrot::Configure::Options::Test::Prepare qw(
+ get_preconfiguration_tests
+ get_postconfiguration_tests
+ );
+
+ ...
+
+ $opttest->run_configure_tests( get_preconfiguration_tests() );
+
+ ...
+
+ $opttest->run_build_tests( get_postconfiguration_tests() );
+
+=head1 DESCRIPTION
+
+This module exports on demand two subroutines, each of which takes no
+arguments and returns a list:
+
+=over 4
+
+=item * C<get_preconfiguration_tests()>
+
+Returns a list of the tests of the mechanics of the configuration system found
+in F<t/configure/> and tests of the configuration step classes found in
+F<t/steps/>.
+
+=item * C<get_postconfiguration_tests()>
+
+Returns a list of the tests found in these directories:
+
+ t/postconfigure/
+ t/tools/pmc2cutils/
+ t/tools/ops2cutils/
+ t/tools/ops2pmutils/
+ t/pharness/
+
+=back
+
+=head1 AUTHOR
+
+James E Keenan.
+
+=head1 SEE ALSO
+
+F<Configure.pl>. F<lib/Parrot/Configure/Options/Test.pm>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Oops, something went wrong.

0 comments on commit a725b2f

Please sign in to comment.