The patch attached provides a small refactoring of Parrot configuration
step auto::pmc. Package global variable %PMC_PARENTS is replaced by an
element in the auto::pmc class's data structure. Two test files replace
the current placeholder file. I will apply in 2-3 days if no one objects.
Thank you very much.
kid51
Index: MANIFEST
===================================================================
--- MANIFEST (revision 22788)
+++ MANIFEST (working copy)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Nov 10 01:52:43 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat Nov 10 16:56:27 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -3061,7 +3061,8 @@
t/configure/121-inter_types-01.t []
t/configure/121-inter_types-02.t []
t/configure/122-auto_ops.t []
-t/configure/123-auto_pmc.t []
+t/configure/123-auto_pmc-01.t []
+t/configure/123-auto_pmc-02.t []
t/configure/124-auto_alignptrs-01.t []
t/configure/124-auto_alignptrs-02.t []
t/configure/124-auto_alignptrs-03.t []
Index: t/configure/123-auto_pmc-02.t
===================================================================
--- t/configure/123-auto_pmc-02.t (revision 0)
+++ t/configure/123-auto_pmc-02.t (revision 0)
@@ -0,0 +1,158 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 123-auto_pmc-02.t
+
+use strict;
+use warnings;
+use Test::More qw(no_plan); # tests => 22;
+use Carp;
+use Cwd;
+use File::Path qw| mkpath |;
+use File::Temp qw| tempdir |;
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
+use_ok('config::auto::pmc');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw( test_step_thru_runstep);
+
+my $args = process_options(
+ {
+ argv => [ ],
+ mode => q{configure},
+ }
+);
+
+my $conf = Parrot::Configure->new;
+
+test_step_thru_runstep( $conf, q{init::defaults}, $args );
+
+my $pkg = q{auto::pmc};
+
+$conf->add_steps($pkg);
+$conf->options->set( %{$args} );
+
+my ( $task, $step_name, @step_params, $step);
+$task = $conf->steps->[1];
+$step_name = $task->step;
[EMAIL PROTECTED] = @{ $task->params };
+
+$step = $step_name->new();
+ok( defined $step, "$step_name constructor returned defined value" );
+
+my $cwd = cwd();
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ ok( chdir $tdir, 'changed to temp directory for testing' );
+
+ my $pmc_with_PCCMETHOD = q{yes.pmc};
+ open my $IN1, ">", $pmc_with_PCCMETHOD
+ or croak "Unable to open file for writing: $!";
+ print $IN1 "PCCMETHOD\n";
+ close $IN1 or croak "Unable to close file after writing: $!";
+ ok(auto::pmc::contains_pccmethod($pmc_with_PCCMETHOD),
+ "Internal subroutine contains_pccmethod returns true as expected");
+
+ my $pmc_sans_PCCMETHOD = q{no.pmc};
+ open my $IN2, ">", $pmc_sans_PCCMETHOD
+ or croak "Unable to open file for writing: $!";
+ print $IN2 "Hello world\n";
+ close $IN2 or croak "Unable to close file after writing: $!";
+ ok( ! defined (
+ auto::pmc::contains_pccmethod($pmc_sans_PCCMETHOD)
+ ), "Internal subroutine contains_pccmethod returns true as expected"
+ );
+
+ my $file = 'foobar';
+ eval { auto::pmc::contains_pccmethod($file); };
+ like($@, qr/Can't read '$file'/, "Got expected 'die' message"); #'
+
+ ok( chdir $cwd, 'changed back to original directory after testing' );
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ ok( chdir $tdir, 'changed to temp directory for testing' );
+
+ my $pmcdir = qq{$tdir/src/pmc};
+ ok(mkpath($pmcdir, 0, 0755), "Able to make directory for testing");
+ my $num = qq{$pmcdir/pmc.num};
+ open my $IN3, ">", $num or croak "Unable to open file for writing: $!";
+ print $IN3 "# comment line\n";
+ print $IN3 "\n";
+ print $IN3 "default.pmc\t0\n";
+ print $IN3 "null.pmc 1\n";
+ print $IN3 "env.pmc 2\n";
+ print $IN3 "notapmc 3\n";
+ close $IN3 or croak "Unable to close file after writing: $!";
+ my $order_ref = auto::pmc::get_pmc_order();
+ is_deeply(
+ $order_ref,
+ {
+ 'default.pmc' => 0,
+ 'null.pmc' => 1,
+ 'env.pmc' => 2,
+ },
+ "Able to read src/pmc/pmc.num correctly"
+ );
+
+ my @pmcs = qw| env.pmc default.pmc null.pmc other.pmc |;
+ my @sorted_pmcs = auto::pmc::sort_pmcs(@pmcs);
+ is_deeply(
+ [EMAIL PROTECTED],
+ [ qw| default.pmc null.pmc env.pmc other.pmc | ],
+ "PMCs sorted correctly"
+ );
+
+ ok( chdir $cwd, 'changed back to original directory after testing' );
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ ok( chdir $tdir, 'changed to temp directory for testing' );
+
+ my $pmcdir = qq{$tdir/src/pmc};
+ ok(mkpath($pmcdir, 0, 0755), "Able to make directory for testing");
+ eval { my $order_ref = auto::pmc::get_pmc_order(); };
+ like($@, qr/Can't read src\/pmc\/pmc\.num/, "Got expected 'die' message");
+
+ ok( chdir $cwd, 'changed back to original directory after testing' );
+}
+
+pass("Keep Devel::Cover happy");
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+123-auto_pmc-02.t - test config::auto::pmc
+
+=head1 SYNOPSIS
+
+ % prove t/configure/123-auto_pmc-02.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by F<Configure.pl>.
+
+The tests in this file test subroutines found in config::auto::pmc
+called within that class's C<runstep() method.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+config::auto::pmc, F<Configure.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: t/configure/123-auto_pmc-02.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: t/configure/123-auto_pmc.t
===================================================================
--- t/configure/123-auto_pmc.t (revision 22788)
+++ t/configure/123-auto_pmc.t (working copy)
@@ -1,46 +0,0 @@
-#! perl
-# Copyright (C) 2007, The Perl Foundation.
-# $Id$
-# 123-auto_pmc.t
-
-use strict;
-use warnings;
-use Test::More tests => 2;
-use Carp;
-use lib qw( lib );
-use_ok('config::auto::pmc');
-
-pass("Completed all tests in $0");
-
-################### DOCUMENTATION ###################
-
-=head1 NAME
-
-123-auto_pmc.t - test config::auto::pmc
-
-=head1 SYNOPSIS
-
- % prove t/configure/123-auto_pmc.t
-
-=head1 DESCRIPTION
-
-The files in this directory test functionality used by F<Configure.pl>.
-
-The tests in this file test subroutines exported by config::auto::pmc.
-
-=head1 AUTHOR
-
-James E Keenan
-
-=head1 SEE ALSO
-
-config::auto::pmc, F<Configure.pl>.
-
-=cut
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Index: t/configure/123-auto_pmc-01.t
===================================================================
--- t/configure/123-auto_pmc-01.t (revision 0)
+++ t/configure/123-auto_pmc-01.t (revision 0)
@@ -0,0 +1,81 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 123-auto_pmc-01.t
+
+use strict;
+use warnings;
+use Test::More qw(no_plan); # tests => 13;
+use Carp;
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
+use_ok('config::auto::pmc');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw( test_step_thru_runstep);
+
+my $args = process_options(
+ {
+ argv => [ ],
+ mode => q{configure},
+ }
+);
+
+my $conf = Parrot::Configure->new;
+
+test_step_thru_runstep( $conf, q{init::defaults}, $args );
+
+my $pkg = q{auto::pmc};
+
+$conf->add_steps($pkg);
+$conf->options->set( %{$args} );
+
+my ( $task, $step_name, @step_params, $step);
+$task = $conf->steps->[1];
+$step_name = $task->step;
[EMAIL PROTECTED] = @{ $task->params };
+
+$step = $step_name->new();
+ok( defined $step, "$step_name constructor returned defined value" );
+isa_ok( $step, $step_name );
+ok( $step->description(), "$step_name has description" );
+
+my $ret = $step->runstep($conf);
+ok( $ret, "$step_name runstep() returned true value" );
+
+pass("Keep Devel::Cover happy");
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+123-auto_pmc-01.t - test config::auto::pmc
+
+=head1 SYNOPSIS
+
+ % prove t/configure/123-auto_pmc-01.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by F<Configure.pl>.
+
+The tests in this file test subroutines found in config::auto::pmc in
+the most ordinary case.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+config::auto::pmc, F<Configure.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: t/configure/123-auto_pmc-01.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: config/auto/pmc.pm
===================================================================
--- config/auto/pmc.pm (revision 22788)
+++ config/auto/pmc.pm (working copy)
@@ -30,17 +30,17 @@
$data{description} = q{Determining what pmc files should be compiled in};
$data{args} = [ qw( ask pmc ) ];
$data{result} = q{};
+ $data{PMC_PARENTS} = {};
return \%data;
}
-my %PMC_PARENTS;
-
# Return the (lowercased) name of the immediate parent of the given
# (lowercased) pmc name.
sub pmc_parent {
+ my $self = shift;
my ($pmc) = @_;
- return $PMC_PARENTS{$pmc} if defined $PMC_PARENTS{$pmc};
+ return $self->{PMC_PARENTS}->{$pmc} if defined
$self->{PMC_PARENTS}->{$pmc};
local $/;
open( my $PMC, "<", "src/pmc/$pmc.pmc" )
@@ -52,16 +52,18 @@
s/^.*?pmclass//s;
s/\{.*$//s;
- return $PMC_PARENTS{$pmc} = lc($1) if m/extends\s+(\w+)/;
- return $PMC_PARENTS{$pmc} = 'default';
+ return $self->{PMC_PARENTS}->{$pmc} = lc($1) if m/extends\s+(\w+)/;
+ return $self->{PMC_PARENTS}->{$pmc} = 'default';
}
# Return an array of all
sub pmc_parents {
+ my $self = shift;
my ($pmc) = @_;
my @parents = ($pmc);
- push @parents, pmc_parent( $parents[-1] ) until $parents[-1] eq 'default';
+ push @parents, $self->pmc_parent( $parents[-1] )
+ until $parents[-1] eq 'default';
shift(@parents);
return @parents;
@@ -89,16 +91,11 @@
for (@pmcs) {
if ( exists $pmc_order->{$_} ) {
$sorted_pmcs[ $pmc_order->{$_} ] = $_;
-
- #if (exists $pmc_order->{"const$_"}) {
- # $sorted_pmcs[$pmc_order->{"const$_"}] = "const$_";
- #}
}
else {
$sorted_pmcs[ $n++ ] = $_;
}
}
- ## print "***\n", join(' ', @sorted_pmcs), "\n";
return @sorted_pmcs;
}
@@ -166,11 +163,12 @@
next if ( $pmc =~ /^const/ );
# make each pmc depend upon its parent.
- my $parent = pmc_parent($pmc) . ".pmc";
my $parent_dumps = '';
- $parent_dumps .= "src/pmc/$_.dump " foreach reverse( (
pmc_parents($pmc) ) );
+ $parent_dumps .= "src/pmc/$_.dump "
+ foreach reverse( ( $self->pmc_parents($pmc) ) );
my $parent_headers = '';
- $parent_headers .= "src/pmc/pmc_$_.h " foreach ( pmc_parents($pmc) );
+ $parent_headers .= "src/pmc/pmc_$_.h "
+ foreach ( $self->pmc_parents($pmc) );
# make each pmc depend upon PCCMETHOD.pm if it uses PCCMETHOD
my $pmc_fname = catfile('src', 'pmc', "$pmc.pmc");
