Please review the patch attached, which consists of 5 new test files:
t/configure/109-inter_lex.01.t
... thru ...
t/configure/109-inter_lex.05.t
... as well as a refactored config/inter/lex.pm. The refactorings had
as their objectives (a) eliminating untestable parts of conditions; and
(b) providing a way to rig up tests of code depending on settings of
environmental values.
Feedback welcome on OSes other than Darwin and Linux. Thank you very much.
kid51
Index: MANIFEST
===================================================================
--- MANIFEST (revision 21118)
+++ MANIFEST (working copy)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Thu Sep 6 19:17:40 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Sep 7 02:52:21 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2928,6 +2928,11 @@
t/configure/106-init_headers.t []
t/configure/107-inter_progs.01.t []
t/configure/107-inter_progs.02.t []
+t/configure/109-inter_lex.01.t []
+t/configure/109-inter_lex.02.t []
+t/configure/109-inter_lex.03.t []
+t/configure/109-inter_lex.04.t []
+t/configure/109-inter_lex.05.t []
t/configure/testlib/Make_VERSION_File.pm []
t/configure/testlib/Tie/Filehandle/Preempt/Stdin.pm []
t/configure/testlib/init/alpha.pm []
Index: t/configure/109-inter_lex.01.t
===================================================================
--- t/configure/109-inter_lex.01.t (revision 0)
+++ t/configure/109-inter_lex.01.t (revision 0)
@@ -0,0 +1,80 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 109-inter_lex.01.t
+
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Carp;
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
+use_ok('config::inter::lex');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::IO::Capture::Mini;
+use Parrot::Configure::Test qw( test_step_thru_runstep);
+
+my $args = process_options( {
+ argv => [ q{--ask} ],
+ mode => q{configure},
+} );
+
+my $conf = Parrot::Configure->new();
+
+test_step_thru_runstep($conf, q{init::defaults}, $args);
+
+my ($task, $step_name, @step_params, $step, $ret);
+my $pkg = q{inter::lex};
+
+$conf->add_steps($pkg);
+$conf->options->set(%{$args});
+$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");
+$ret = $step->runstep($conf);
+ok(defined $ret, "$step_name runstep() returned defined value");
+is($step->result(), q{skipped},
+ "Step was skipped as expected; no '--maintainer' option");
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+109-inter_lex.01.t - test config::inter::lex
+
+=head1 SYNOPSIS
+
+ % prove t/configure/109-inter_lex.01.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::inter::lex. In
+this case, only the C<--ask> option is provided. Because the C<--maintainer>
+option is not provided, the step is skipped and no prompt is ever reached.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+config::inter::lex, 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/109-inter_lex.01.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: t/configure/109-inter_lex.02.t
===================================================================
--- t/configure/109-inter_lex.02.t (revision 0)
+++ t/configure/109-inter_lex.02.t (revision 0)
@@ -0,0 +1,84 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 109-inter_lex.02.t
+
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Carp;
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
+use_ok('config::inter::lex');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw( test_step_thru_runstep);
+
+$ENV{LEX} = 'foobar';
+
+my $args = process_options( {
+ argv => [ q{--ask}, q{--maintainer} ],
+ mode => q{configure},
+} );
+
+my $conf = Parrot::Configure->new();
+
+test_step_thru_runstep($conf, q{init::defaults}, $args);
+
+my ($task, $step_name, @step_params, $step, $ret);
+my $pkg = q{inter::lex};
+
+$conf->add_steps($pkg);
+$conf->options->set(%{$args});
+
+$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");
+$ret = $step->runstep($conf);
+ok(defined $ret, "$step_name runstep() returned defined value");
+my $result_expected = q{user defined};
+is($step->result(), $result_expected,
+ "Result was $result_expected because environmental variable was set");
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+109-inter_lex.02.t - test config::inter::lex
+
+=head1 SYNOPSIS
+
+ % prove t/configure/109-inter_lex.02.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::inter::lex. In
+this case, the C<--ask> and C<--maintainer> options are provided but the
+F<lex>-equivalent program is provided by the user via an environmental
+variable. As a result, no prompt is ever reached.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+config::inter::lex, 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/109-inter_lex.02.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: t/configure/109-inter_lex.03.t
===================================================================
--- t/configure/109-inter_lex.03.t (revision 0)
+++ t/configure/109-inter_lex.03.t (revision 0)
@@ -0,0 +1,84 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 109-inter_lex.03.t
+
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Carp;
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
+$ENV{TEST_LEX} = 'foobar';
+use_ok('config::inter::lex');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw( test_step_thru_runstep);
+
+my $args = process_options( {
+ argv => [ q{--ask}, q{--maintainer} ],
+ mode => q{configure},
+} );
+
+my $conf = Parrot::Configure->new();
+
+test_step_thru_runstep($conf, q{init::defaults}, $args);
+
+my ($task, $step_name, @step_params, $step, $ret);
+my $pkg = q{inter::lex};
+
+$conf->add_steps($pkg);
+$conf->options->set(%{$args});
+
+$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");
+$ret = $step->runstep($conf);
+is($ret, undef, "$step_name runstep() returned undefined value");
+my $result_expected = q{no lex program was found};
+is($step->result(), $result_expected,
+ "Result was $result_expected");
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+109-inter_lex.03.t - test config::inter::lex
+
+=head1 SYNOPSIS
+
+ % prove t/configure/109-inter_lex.03.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::inter::lex. In
+this case, the C<--ask> and C<--maintainer> options are provided but an
+environmental variable was provided in order to trick the package into not
+finding a real F<lex>-equivalent program. As a result, no prompt is ever
+reached.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+config::inter::lex, 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/109-inter_lex.03.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: t/configure/109-inter_lex.04.t
===================================================================
--- t/configure/109-inter_lex.04.t (revision 0)
+++ t/configure/109-inter_lex.04.t (revision 0)
@@ -0,0 +1,93 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 109-inter_lex.04.t
+
+use strict;
+use warnings;
+use Test::More tests => 14;
+use Carp;
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
+use_ok('config::inter::lex');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw( test_step_thru_runstep);
+use Tie::Filehandle::Preempt::Stdin;
+
+my $args = process_options( {
+ argv => [ q{--ask}, q{--maintainer}, q{--lex=flex} ],
+ mode => q{configure},
+} );
+
+my $conf = Parrot::Configure->new();
+
+test_step_thru_runstep($conf, q{init::defaults}, $args);
+
+my (@prompts, $object, @entered);
[EMAIL PROTECTED] = map { q{foo_} . $_ }
+ qw| alpha |;
[EMAIL PROTECTED] = ( q{lex} );
+$object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts;
+can_ok('Tie::Filehandle::Preempt::Stdin', ('READLINE'));
+isa_ok($object, 'Tie::Filehandle::Preempt::Stdin');
+
+my ($task, $step_name, @step_params, $step, $ret);
+my $pkg = q{inter::lex};
+
+$conf->add_steps($pkg);
+$conf->options->set(%{$args});
+
+$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");
+$ret = $step->runstep($conf);
+ok(defined $ret, "$step_name runstep() returned defined value");
+my $result_expected = q{user defined};
+is($step->result(), $result_expected,
+ "Result was $result_expected");
+
+$object = undef;
+untie *STDIN;
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+109-inter_lex.04.t - test config::inter::lex
+
+=head1 SYNOPSIS
+
+ % prove t/configure/109-inter_lex.04.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::inter::lex. In
+this test the C<--ask>, C<--maintainer> and C<--lex=flex> options are
+provided.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+config::inter::lex, 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/109-inter_lex.04.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: t/configure/109-inter_lex.05.t
===================================================================
--- t/configure/109-inter_lex.05.t (revision 0)
+++ t/configure/109-inter_lex.05.t (revision 0)
@@ -0,0 +1,109 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 109-inter_lex.05.t
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Test::More tests => 14;
+use Carp;
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
+use_ok('config::inter::lex');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::IO::Capture::Mini;
+use Parrot::Configure::Test qw( test_step_thru_runstep);
+use Tie::Filehandle::Preempt::Stdin;
+
+my $args = process_options( {
+ argv => [ q{--ask}, q{--maintainer} ],
+ mode => q{configure},
+} );
+
+my $conf = Parrot::Configure->new();
+
+test_step_thru_runstep($conf, q{init::defaults}, $args);
+
+my (@prompts, $object, @entered);
[EMAIL PROTECTED] = q{flex};
+$object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts;
+can_ok('Tie::Filehandle::Preempt::Stdin', ('READLINE'));
+isa_ok($object, 'Tie::Filehandle::Preempt::Stdin');
+
+my ($task, $step_name, @step_params, $step, $ret);
+my $pkg = q{inter::lex};
+
+$conf->add_steps($pkg);
+$conf->options->set(%{$args});
+
+$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 $tie_out = tie *STDOUT, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ $ret = $step->runstep($conf);
+ my @more_lines = $tie_out->READLINE;
+ my $possible_results = qr/^(
+ no\slex\sprogram\swas\sfound
+ | lex\sprogram\sdoes\snot\sexist\sor\sdoes\snot\sunderstand\s--version
+ | could\snot\sunderstand\sflex\sversion\srequirement
+ | found\sflex\sversion.*?but\sat\sleast.*?is\srequired
+ | flex
+ )/x;
+ my @dump_msg = ( Dumper($step->result()) =~ /'(.*?)'/ );
+ like($step->result(), $possible_results,
+ "Response to prompt led to acceptable result: " . $dump_msg[0]);
+ if ($dump_msg[0] eq q{no lex program was found}) {
+ ok(! @more_lines, "No lex program => no prompts");
+ } else {
+ ok(@more_lines, "prompts were captured");
+ }
+}
+
+
+$object = undef;
+untie *STDIN;
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+109-inter_lex.05.t - test config::inter::lex
+
+=head1 SYNOPSIS
+
+ % prove t/configure/109-inter_lex.05.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::inter::lex.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+config::inter::lex, 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/109-inter_lex.05.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: config/inter/lex.pm
===================================================================
--- config/inter/lex.pm (revision 21118)
+++ config/inter/lex.pm (working copy)
@@ -28,6 +28,10 @@
$prompt = "Do you have a lexical analyzer generator like flex or lex?";
@args = qw( lex ask maintainer );
+my @lex_defaults = defined($ENV{TEST_LEX})
+ ? $ENV{TEST_LEX}
+ : qw( flex lex );
+
my $default_required = '2.5.33';
sub runstep {
@@ -44,12 +48,12 @@
return $self;
}
- my $prog;
-
# precedence of sources for the program:
# default -> probe -> environment -> option -> ask
- $prog ||= $conf->options->get($util);
- $prog ||= $ENV{ uc($util) };
+ my $prog = $conf->options->get($util);
+ unless ($prog) {
+ $prog = $ENV{ uc($util) };
+ }
# never override the user. If a non-existent program is specified then
# the user is responsible for the consequences.
@@ -57,77 +61,71 @@
$conf->data->set( $util => $prog );
$self->set_result('user defined');
return $self;
- }
-
- $prog = check_progs( [ 'flex', 'lex' ], $verbose );
-
- unless ($prog) {
- $self->set_result('no lex program was found');
- return;
- }
-
- # RT#43170 should --ask be handled like the other user defines or
- # checked for version requirements?
- if ( $conf->options->get('ask') ) {
- $prog = prompt( $prompt, $prog ? $prog : $conf->data->get($util) );
- }
-
- my ( $stdout, $stderr, $ret ) = capture_output( $prog, '--version' );
-
- # don't override the user even if the program they provided appears to be
- # broken
- if ( $ret == -1 and !$conf->options->get('ask') ) {
-
- # fall back to default
- $self->set_result('lex program does not exist or does not understand
--version');
- return;
- }
-
- # if '--version' returns a string assume that this is flex.
- # flex calls it self by $0 so it will claim to be lex if invoked as `lex`
- if ( $stdout =~ /f?lex .*? (\d+) \. (\d+) \. (\d+)/x ) {
- my ( $prog_major, $prog_minor, $prog_patch ) = ( $1, $2, $3 );
- my $prog_version = "$1.$2.$3";
-
- # is there a version requirement?
- my $req = $conf->options->get('flex_required');
- unless ( defined $req ) {
- $req = $default_required;
- }
- if ($req) {
- my ( $rmajor, $rminor, $rpatch ) = ( $req =~ / ^ (\d+) \. (\d+) \.
(\d+) $ /x );
- unless ( defined $rmajor ) {
- $self->set_result("could not understand flex version
requirement");
- return;
+ } else {
+ $prog = check_progs( [ @lex_defaults ], $verbose );
+ if (! $prog) {
+ $self->set_result('no lex program was found');
+ return;
+ } else {
+ # RT#43170 should --ask be handled like the other user defines or
+ # checked for version requirements?
+ if ( $conf->options->get('ask') ) {
+ $prog = prompt(
+ $prompt, $prog ? $prog : $conf->data->get($util)
+ );
}
-
- if (
- $prog_major < $rmajor
-
- or ( $prog_major == $rmajor
- and $prog_minor < $rminor )
-
- or ( $prog_major == $rmajor
- and $prog_minor == $rminor
- and $prog_patch < $rpatch )
- )
- {
- $self->set_result( "found flex version $prog_version"
- . " but at least $rmajor.$rminor.$rpatch is required"
);
+ my ( $stdout, $stderr, $ret ) =
+ capture_output( $prog, '--version' );
+ # don't override the user even if the program they provided
+ # appears to be broken
+ if ( $ret == -1 and !$conf->options->get('ask') ) {
+ # fall back to default
+ $self->set_result('lex program does not exist or does not
understand --version');
return;
+ } elsif ( $stdout =~ /f?lex .*? (\d+) \. (\d+) \. (\d+)/x ) {
+ # if '--version' returns a string assume that this is flex.
+ # flex calls it self by $0 so it will claim to be lex
+ # if invoked as `lex`
+ my ( $prog_major, $prog_minor, $prog_patch ) = ( $1, $2, $3 );
+ my $prog_version = "$1.$2.$3";
+
+ # is there a version requirement?
+ my $req = $conf->options->get('flex_required');
+ unless ( defined $req ) {
+ $req = $default_required;
+ }
+ if ($req) {
+ my ( $rmajor, $rminor, $rpatch ) =
+ ( $req =~ / ^ (\d+) \. (\d+) \. (\d+) $ /x );
+ if (! defined $rmajor ) {
+ $self->set_result(
+ "could not understand flex version requirement");
+ return;
+ } elsif (
+ $prog_major < $rmajor
+ or ( $prog_major == $rmajor
+ and $prog_minor < $rminor )
+ or ( $prog_major == $rmajor
+ and $prog_minor == $rminor
+ and $prog_patch < $rpatch )
+ ) {
+ $self->set_result( "found flex version $prog_version"
+ . " but at least $rmajor.$rminor.$rpatch is
required" );
+ return;
+ } else {
+ 1; # lack an explicit 'else' here
+ }
+ }
+ $conf->data->set( flex_version => $prog_version );
+ $self->set_result("flex $prog_version");
+ $conf->data->set( $util => $prog );
+ return $self;
+ } else {
+ $self->set_result('lex program does not exist or does not
understand --version');
+ return;
}
}
-
- $conf->data->set( flex_version => $prog_version );
- $self->set_result("flex $prog_version");
- $conf->data->set( $util => $prog );
}
- else {
- $self->set_result('lex program does not exist or does not understand
--version');
- return;
- }
-
- return $self;
}
1;
