[svn:parrot] r48598 - in trunk: config/auto t/steps/auto
jkeenan at svn.parrot.org
jkeenan at svn.parrot.org
Sun Aug 22 23:49:10 UTC 2010
Author: jkeenan
Date: Sun Aug 22 23:49:08 2010
New Revision: 48598
URL: https://trac.parrot.org/parrot/changeset/48598
Log:
[configure] Provide for warnings where .pmc files are present in src/pmc/ but are not listed in MANIFEST. Add tests for this functionality. Cf. http://trac.parrot.org/parrot/ticket/865.
Modified:
trunk/config/auto/pmc.pm
trunk/t/steps/auto/pmc-01.t
Modified: trunk/config/auto/pmc.pm
==============================================================================
--- trunk/config/auto/pmc.pm Sun Aug 22 22:03:03 2010 (r48597)
+++ trunk/config/auto/pmc.pm Sun Aug 22 23:49:08 2010 (r48598)
@@ -249,7 +249,41 @@
# With the test for definedness below, we account for PMCs which have been
# deactivated but whose index numbers remain in src/pmc/pmc.num.
- return join(' ' => grep { defined $_ } @sorted_pmcs);
+# return join(' ' => grep { defined $_ } @sorted_pmcs);
+ my $active_pmcs = [ grep { defined $_ } @sorted_pmcs ];
+
+ # At this point we check to see whether any active_pmcs are missing from
+ # the MANIFEST. We warn about any such missing PMCs but (for the time
+ # being at least) we proceed to compose $pmc_str.
+ my $seen_manifest = pmcs_in_manifest();
+ check_pmcs_against_manifest( $active_pmcs, $seen_manifest );
+ return join(' ' => @{ $active_pmcs });
+}
+
+sub pmcs_in_manifest {
+ my $manifest = shift || 'MANIFEST';
+ my %seen_manifest = ();
+ open my $MAN, '<', $manifest
+ or die "Unable to open MANIFEST: $!";
+ while (my $f = <$MAN>) {
+ chomp $f;
+ if ($f =~ m{^src/pmc/(.*\.pmc)}) {
+ my $pmc = $1;
+ $seen_manifest{$pmc}++;
+ }
+ }
+ close $MAN or die "Unable to close MANIFEST: $!";
+ return \%seen_manifest;
+}
+
+# check_pmcs_against_manifest( $active_pmcs, $seen_manifest );
+sub check_pmcs_against_manifest {
+ my ($active_pmcs, $seen_manifest) = @_;
+ my @missing_from_manifest = grep { ! exists $seen_manifest->{$_} }
+ @{ $active_pmcs };
+ if (@missing_from_manifest) {
+ warn "PMCs found in /src/pmc not found in MANIFEST: @missing_from_manifest";
+ }
}
sub contains_pccmethod {
Modified: trunk/t/steps/auto/pmc-01.t
==============================================================================
--- trunk/t/steps/auto/pmc-01.t Sun Aug 22 22:03:03 2010 (r48597)
+++ trunk/t/steps/auto/pmc-01.t Sun Aug 22 23:49:08 2010 (r48598)
@@ -5,7 +5,7 @@
use strict;
use warnings;
-use Test::More tests => 23;
+use Test::More tests => 30;
use Carp;
use Cwd;
use File::Path qw| mkpath |;
@@ -17,6 +17,7 @@
use Parrot::Configure::Test qw(
test_step_constructor_and_description
);
+use IO::CaptureOutput qw( capture );
########## regular ##########
@@ -94,14 +95,14 @@
my $pmcdir = qq{$tdir/src/pmc};
ok(mkpath($pmcdir, { mode => 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: $!";
+ open my $OUT3, ">", $num or croak "Unable to open file for writing: $!";
+ print $OUT3 "# comment line\n";
+ print $OUT3 "\n";
+ print $OUT3 "default.pmc\t0\n";
+ print $OUT3 "null.pmc 1\n";
+ print $OUT3 "env.pmc 2\n";
+ print $OUT3 "notapmc 3\n";
+ close $OUT3 or croak "Unable to close file after writing: $!";
my $order_ref = auto::pmc::get_pmc_order();
is_deeply(
$order_ref,
@@ -114,7 +115,12 @@
);
my @pmcs = qw| env.pmc default.pmc null.pmc other.pmc |;
- my @sorted_pmcs = split / /, auto::pmc::get_sorted_pmc_str(@pmcs);
+ my $pseudoman = 'MANIFEST';
+ open my $MAN, '>', $pseudoman or croak "Unable to open $pseudoman";
+ print $MAN "src/pmc/$_\n" for @pmcs;
+ close $MAN or croak;
+ my @sorted_pmcs =
+ split / /, auto::pmc::get_sorted_pmc_str(@pmcs);
is_deeply(
\@sorted_pmcs,
[ qw| default.pmc null.pmc env.pmc other.pmc | ],
@@ -130,6 +136,61 @@
my $pmcdir = qq{$tdir/src/pmc};
ok(mkpath($pmcdir, { mode => 0755 }), "Able to make directory for testing");
+ my $num = qq{$pmcdir/pmc.num};
+ open my $OUT4, ">", $num or croak "Unable to open file for writing: $!";
+ print $OUT4 "# comment line\n";
+ print $OUT4 "\n";
+ print $OUT4 "default.pmc\t0\n";
+ print $OUT4 "null.pmc 1\n";
+ print $OUT4 "env.pmc 2\n";
+ print $OUT4 "notapmc 3\n";
+ close $OUT4 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 $pseudoman = 'MANIFEST';
+ open my $MAN, '>', $pseudoman or croak "Unable to open $pseudoman";
+ print $MAN "src/pmc/$_\n" for @pmcs[0..2];
+ close $MAN or croak;
+ {
+ my ($stdout, $stderr);
+ my @sorted_pmcs;
+ capture( sub {
+ @sorted_pmcs = split / /,
+ auto::pmc::get_sorted_pmc_str(@pmcs);
+ },
+ \$stdout,
+ \$stderr,
+ );
+ like( $stderr,
+ qr/PMCs found in \/src\/pmc not found in MANIFEST: $pmcs[3]/,
+ "Got expected warning",
+ );
+ is_deeply(
+ \@sorted_pmcs,
+ [ 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, { mode => 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");
@@ -138,6 +199,9 @@
ok( chdir $cwd, 'changed back to original directory after testing' );
}
+my $seen_man = auto::pmc::pmcs_in_manifest();
+ok( keys %{$seen_man}, 'src/pmc/*.pmc files were seen in MANIFEST' );
+
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
More information about the parrot-commits
mailing list