File Coverage

File:lib/Parrot/Configure/Options/Test.pm
Coverage:95.9%

linestmtbrancondsubcode
1# Copyright (C) 2001-2006, Parrot Foundation.
2package Parrot::Configure::Options::Test;
3
3
3
3
3
use strict;
4
3
3
3
3
use warnings;
5
3
3
3
3
use Carp;
6
3
3
3
3
use Test::Harness;
7
3
3
3
3
use lib qw(lib);
8
3
3
3
3
use Parrot::Configure::Step::List qw( get_steps_list );
9
3
3
3
3
use Parrot::Configure::Options::Test::Prepare qw( get_steps_missing_tests );
10
11sub new {
12
7
7
    my ( $class, $argsref ) = @_;
13
7
    my $self = {};
14
7
    bless $self, $class;
15
7
100
    if ( defined $argsref->{test} ) {
16
5
100
100
100
        if ( $argsref->{test} eq '1' ) {
17
2
            $self->set_run('run_configure_tests', 1);
18
2
            $self->set_run('run_build_tests', 1);
19        }
20        elsif ( $argsref->{test} eq 'configure' ) {
21
1
            $self->set_run('run_configure_tests', 1);
22        }
23        elsif ( $argsref->{test} eq 'build' ) {
24
1
            $self->set_run('run_build_tests', 1);
25        }
26        else {
27
1
            die "'$argsref->{test}' is a bad value for command-line option 'test'";
28        }
29    }
30
6
60
    my %excluded_options = map {$_ => 1} qw|
31        ask
32        configure_trace
33        debugging
34        fatal
35        fatal-step
36        help
37        script
38        silent
39        verbose
40        verbose-step
41    |;
42
6
11
6
    for my $k (grep { ! $excluded_options{$_} } keys %{$argsref}) {
43
4
        $self->set($k, $argsref->{$k});
44    }
45
6
    return $self;
46}
47
48sub set {
49
6
6
    my $self = shift;
50
6
100
    die "Need 2 arguments to Parrot::Configure::Options::Test::set()"
51        unless @_ == 2;
52
5
    my ($option, $value) = @_;
53
5
    $self->{options}{$option} = $value;
54}
55
56sub get {
57
3
3
    my $self = shift;
58
3
100
    die "Need 1 argument to Parrot::Configure::Options::Test::get()"
59        unless @_ == 1;
60
2
    my $option = shift;
61
2
100
    return $self->{options}{$option} || undef;
62}
63
64sub set_run {
65
8
8
    my $self = shift;
66
8
100
    die "Need 2 arguments to Parrot::Configure::Options::Test::set_run()"
67        unless @_ == 2;
68
7
    my ($option, $value) = @_;
69
7
    $self->{run}{$option} = $value;
70}
71
72sub get_run {
73
6
6
    my $self = shift;
74
6
100
    die "Need 1 argument to Parrot::Configure::Options::Test::get_run()"
75        unless @_ == 1;
76
5
    my $option = shift;
77
5
100
    return $self->{run}{$option} || undef;
78}
79
80sub run_configure_tests {
81
2
2
    my $self = shift;
82
2
    my @preconfiguration_tests = @_;
83
2
100
    if ( $self->get_run('run_configure_tests') ) {
84
1
        my $start = time();
85
1
        print "As you requested, we'll start with some tests of the configuration tools.\n\n";
86
87
1
50
        runtests(@preconfiguration_tests) or die
88            "Pre-configuration tests did not complete successfully; Configure.pl will not continue.";
89
1
        print <<"TEST";
90
91I just ran some tests to demonstrate that
92Parrot's configuration tools will work as intended.
93
94TEST
95
1
        my $end =time();
96
1
        print scalar(@preconfiguration_tests),
97            " t/configure tests took ",
98            ($end - $start), " seconds.\n";
99    }
100
2
    return 1;
101}
102
103sub run_build_tests {
104
2
2
    my $self = shift;
105
2
    my @postconfiguration_tests = @_;
106
2
100
    if ( $self->get_run('run_build_tests') ) {
107
1
        my $start = time();
108
1
        print "\n\n";
109
1
        print "As you requested, I will now run some tests of the build tools.\n\n";
110
1
        my @steps_missing_tests = get_steps_missing_tests();
111
1
50
        if (@steps_missing_tests) {
112
0
            print "The following configuration steps lack corresponding tests:\n";
113
0
            print " $_\n" for @steps_missing_tests;
114        }
115
1
50
        runtests(@postconfiguration_tests) or die
116            "Post-configuration and build tools tests did not complete successfully; running 'make' might be dubious.";
117
1
        my $end =time();
118
1
        print scalar(@postconfiguration_tests),
119            " t/steps, t/postconfigure and t/pharness tests took ",
120            ($end - $start), " seconds.\n";
121    }
122
2
    return 1;
123}
124
1251;
126
127#################### DOCUMENTATION ####################
128
129 - 255
=head1 NAME

Parrot::Configure::Options::Test - Run configuration and build tests along with F<Configure.pl>

=head1 SYNOPSIS

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 ],
        mode            => q{configure},
    } );

    $opttest = Parrot::Configure::Options::Test->new($args);

    $opttest->run_configure_tests( get_preconfiguration_tests() );

    $opttest->run_build_tests( get_postconfiguration_tests() );

On command line:

    # run tests of configuration tools, then configure
    perl Configure.pl  --test=configure

    # configure, then run tests of build tools
    perl Configure.pl  --test=build

    # run tests of configuration tools, then configure,
    # then run tests of build tools
    perl Configure.pl  --test

=head1 DESCRIPTION

Test suites have been constructed which test those of Parrot's configuration
and build tools that are written in Perl 5.  These tests are not necessarily
run when you invoke F<make test>.  In any event, running these tests as part
of F<make test> is, in a certain sense, running them too late.  If you have
successfully called F<Configure.pl> and F<make>, you have implicitly
demonstrated that the configuration and build tools work (for the most part),
so running tests of those tools post-F<make> is somewhat redundant.

On the other hand, tests of the configuration tools I<are> meaningful if run
I<before> F<Configure.pl> is invoked and, similarly, tests of the build tools
I<are> meaningful if run I<before> F<make> is invoked.
Parrot::Configure::Options::Test provides functionality for running such
tests.

=head1 SUBROUTINES

=head2 C<new()>

=over 4

=item * Purpose

Parrot::Configure::Options::Test constructor.

=item * Arguments

One argument:  The hash reference which is the return value of
C<Parrot::Configure::Options::process_options()>.

=item * Return Value

Parrot::Configure::Options::Test object.

=item * Comment

=back

=head2 C<run_configure_tests()>

=over 4

=item * Purpose

Run tests of Parrot's configuration tools.

=item * Arguments

List of test files, typically supplied by
C<Parrot::Configure::Options::Test::Prepare::get_preconfiguration_tests()>.

=item * Return Value

None.

=back

=head2 C<run_build_tests()>

=over 4

=item * Purpose

Run tests of Parrot's build tools.  Also, run tests of certain aspects of the
configuration process which, for legacy reasons, must run after
F<Configure.pl> has completed execution.

=item * Arguments

List of test files, typically supplied by
C<Parrot::Configure::Options::Test::Prepare::get_postconfiguration_tests()>.

=item * Return Value

None.

=back

=head1 AUTHOR

James E Keenan, in response to request by Jerry Gay
in http://rt.perl.org/rt3/Ticket/Display.html?id=42690.

=head1 SEE ALSO

F<Configure.pl>.  F<lib/Parrot/Configure/Options.pm>.

=cut
256
257# Local Variables:
258# mode: cperl
259# cperl-indent-level: 4
260# fill-column: 100
261# End:
262# vim: expandtab shiftwidth=4: