Author: jkeenan
Date: Tue Jul 22 15:29:24 2008
New Revision: 29686
Modified:
branches/parallel/config/gen/call_list.pm
branches/parallel/config/gen/parrot_include.pm
branches/parallel/t/steps/gen_call_list-01.t
branches/parallel/t/steps/gen_parrot_include-01.t
Log:
Refactor steps to pull hard-coded lists of files into the step object's data
structure. Add some basic tests. Some tests in gen_parrot_include-01.t need
fixing yet.
Modified: branches/parallel/config/gen/call_list.pm
==============================================================================
--- branches/parallel/config/gen/call_list.pm (original)
+++ branches/parallel/config/gen/call_list.pm Tue Jul 22 15:29:24 2008
@@ -1,5 +1,5 @@
# Copyright (C) 2008, The Perl Foundation.
-# $Id: $
+# $Id$
=head1 NAME
@@ -31,18 +31,17 @@
sub _init {
my $self = shift;
-
- return {
- description => q{Generating NCI signature list},
- result => q{},
- }
+ my %data;
+ $data{description} = q{Generating NCI signature list};
+ $data{result} = q{};
+ $data{fragment_files} = [ sort glob 'config/gen/call_list/*.in' ];
+ return \%data;
}
sub runstep {
my ( $self, $conf ) = @_;
my $combined_file = 'src/call_list.txt';
- my @fragment_files = sort glob 'config/gen/call_list/*.in';
open my $combined, '>', $combined_file
or die "Could not open '$combined_file' for write: $!";
@@ -50,7 +49,7 @@
# add read-only metadata for the generated file
print {$combined} "# ex: set ro:\n";
- foreach my $fragment_file (@fragment_files) {
+ foreach my $fragment_file ( @{ $self->{fragment_files} } ) {
my $fragment = _slurp($fragment_file);
$fragment =~ s/^\s*\n//;
$fragment =~ s/\s*$/\n\n/;
Modified: branches/parallel/config/gen/parrot_include.pm
==============================================================================
--- branches/parallel/config/gen/parrot_include.pm (original)
+++ branches/parallel/config/gen/parrot_include.pm Tue Jul 22 15:29:24 2008
@@ -23,11 +23,32 @@
sub _init {
my $self = shift;
-
- return {
- description => q{Generating runtime/parrot/include},
- result => q{},
- }
+ my %data;
+ $data{description} = q{Generating runtime/parrot/include};
+ $data{result} = q{};
+ $data{files} = [ qw(
+ include/parrot/cclass.h
+ include/parrot/core_pmcs.h
+ include/parrot/datatypes.h
+ include/parrot/enums.h
+ include/parrot/events.h
+ include/parrot/scheduler.h
+ include/parrot/exceptions.h
+ include/parrot/interpreter.h
+ include/parrot/io.h
+ include/parrot/longopt.h
+ include/parrot/mmd.h
+ include/parrot/resources.h
+ include/parrot/stat.h
+ include/parrot/string.h
+ include/parrot/pmc.h
+ include/parrot/vtable.h
+ include/parrot/warnings.h
+ src/pmc/timer.pmc
+ src/utils.c
+ ) ];
+ $data{destdir} = 'runtime/parrot/include';
+ return \%data;
}
sub const_to_parrot {
@@ -156,28 +177,28 @@
return @d;
}
-my @files = qw(
- include/parrot/cclass.h
- include/parrot/core_pmcs.h
- include/parrot/datatypes.h
- include/parrot/enums.h
- include/parrot/events.h
- include/parrot/scheduler.h
- include/parrot/exceptions.h
- include/parrot/interpreter.h
- include/parrot/io.h
- include/parrot/longopt.h
- include/parrot/mmd.h
- include/parrot/resources.h
- include/parrot/stat.h
- include/parrot/string.h
- include/parrot/pmc.h
- include/parrot/vtable.h
- include/parrot/warnings.h
- src/pmc/timer.pmc
- src/utils.c
-);
-my $destdir = 'runtime/parrot/include';
+#my @files = qw(
+# include/parrot/cclass.h
+# include/parrot/core_pmcs.h
+# include/parrot/datatypes.h
+# include/parrot/enums.h
+# include/parrot/events.h
+# include/parrot/scheduler.h
+# include/parrot/exceptions.h
+# include/parrot/interpreter.h
+# include/parrot/io.h
+# include/parrot/longopt.h
+# include/parrot/mmd.h
+# include/parrot/resources.h
+# include/parrot/stat.h
+# include/parrot/string.h
+# include/parrot/pmc.h
+# include/parrot/vtable.h
+# include/parrot/warnings.h
+# src/pmc/timer.pmc
+# src/utils.c
+#);
+#my $destdir = 'runtime/parrot/include';
sub runstep {
my ( $self, $conf ) = @_;
@@ -186,7 +207,8 @@
system( $^X, "tools/build/vtable_h.pl" );
my @generated;
- for my $file (@files) {
+# for my $file (@files) {
+ for my $file ( @{ $self->{files} } ) {
open my $fh, '<', $file or die "Can't open $file: $!\n";
my @directives = parse_file $file, $fh;
close $fh;
@@ -196,7 +218,7 @@
$conf->options->get('verbose') and print "$target ";
my $gen = join "\n",
( $target =~ /\.pl$/ ? \&const_to_perl : \&const_to_parrot
)->(@defs);
- $conf->append_configure_log(qq{$destdir/$target});
+ $conf->append_configure_log(qq{$self->{destdir}/$target});
my $target_tmp = "$target.tmp";
open my $out, '>', $target_tmp or die "Can't open $target_tmp:
$!\n";
@@ -213,7 +235,7 @@
$gen
EOF
close $out or die "Can't write $target_tmp: $!\n";
- $target =~ m[/] or $target = "$destdir/$target";
+ $target =~ m[/] or $target = "$self->{destdir}/$target";
move_if_diff( $target_tmp, $target );
push @generated, $target;
}
Modified: branches/parallel/t/steps/gen_call_list-01.t
==============================================================================
--- branches/parallel/t/steps/gen_call_list-01.t (original)
+++ branches/parallel/t/steps/gen_call_list-01.t Tue Jul 22 15:29:24 2008
@@ -5,14 +5,34 @@
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More qw(no_plan); # tests => 2;
use Carp;
use lib qw( lib );
use_ok('config::gen::call_list');
-
-=for hints_for_testing This is just a stub so that Configure.pl will run.
-
-=cut
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw(
+ test_step_thru_runstep
+ test_step_constructor_and_description
+);
+
+my $args = process_options(
+ {
+ argv => [ ],
+ mode => q{configure},
+ }
+);
+
+my $conf = Parrot::Configure->new;
+my $pkg = q{gen::call_list};
+$conf->add_steps($pkg);
+$conf->options->set( %{$args} );
+my $step = test_step_constructor_and_description($conf);
+my $missing_files = 0;
+foreach my $f ( @{ $step->{fragment_files} } ) {
+ $missing_files++ unless (-f $f);
+}
+is($missing_files, 0, "No needed source files are missing");
pass("Completed all tests in $0");
Modified: branches/parallel/t/steps/gen_parrot_include-01.t
==============================================================================
--- branches/parallel/t/steps/gen_parrot_include-01.t (original)
+++ branches/parallel/t/steps/gen_parrot_include-01.t Tue Jul 22 15:29:24 2008
@@ -5,15 +5,40 @@
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 7;
use Carp;
+use Data::Dumper;
use lib qw( lib );
use_ok('config::gen::parrot_include');
-
-=for hints_for_testing Consider writing a description of what 'runtime
-parrot include' files means.
-
-=cut
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw(
+ test_step_thru_runstep
+ test_step_constructor_and_description
+);
+
+my $args = process_options(
+ {
+ argv => [ ],
+ mode => q{configure},
+ }
+);
+
+my $conf = Parrot::Configure->new;
+my $pkg = q{gen::parrot_include};
+$conf->add_steps($pkg);
+$conf->options->set( %{$args} );
+my $step = test_step_constructor_and_description($conf);
+TODO: {
+ local $TODO = '2 files in list are generated; need to fix';
+ my %missing_files = ();
+ foreach my $f ( @{ $step->{files} } ) {
+ $missing_files{$f}++ unless (-f $f);
+ }
+ is(keys %missing_files, 0, "No needed source files are missing");
+ print STDERR Dumper \%missing_files;
+}
+ok(-d $step->{destdir}, "Directory needed has been located");
pass("Completed all tests in $0");
