File Coverage

File:config/inter/lex.pm
Coverage:74.5%

linestmtbrancondsubcode
1# Copyright (C) 2001-2007, Parrot Foundation.
2
3 - 12
=head1 NAME

config/auto/lex.pm - lexical analyzer generator

=head1 DESCRIPTION

Determines whether C<lex> is installed and if it's actually C<flex> of
least the user-specified minimum version, defaulting to 2.5.33.

=cut
13
14package inter::lex;
15
16
4
4
4
4
use strict;
17
4
4
4
4
use warnings;
18
19
20
4
4
4
4
use base qw(Parrot::Configure::Step);
21
22
4
4
4
4
use Parrot::Configure::Utils qw( :inter capture_output check_progs );
23
24sub _init {
25
7
7
    my $self = shift;
26
7
    my %data;
27
7
    $data{description} = q{Is lex installed};
28
7
    $data{result} = q{};
29
7
    return \%data;
30}
31
32my @lex_defaults =
33    defined( $ENV{TEST_LEX} )
34    ? $ENV{TEST_LEX}
35    : qw( flex lex );
36
37my $default_required = '2.5.33';
38
39sub runstep {
40
7
7
    my ( $self, $conf ) = @_;
41
7
    my $util = 'lex';
42
7
    my $prompt = "Do you have a lexical analyzer generator like flex or lex?";
43
44
7
    my $verbose = $conf->options->get('verbose');
45
46    # undef means we don't have flex... default to not having flex
47
7
    $conf->data->set( flex_version => undef );
48
49
7
100
    unless ( $conf->options->get('maintainer') ) {
50
2
        $conf->data->set( $util => 'echo' );
51
2
        $self->set_result('skipped');
52
2
        return 1;
53    }
54
55    # precedence of sources for the program:
56    # default -> probe -> environment -> option -> ask
57
5
    my $prog = $conf->options->get($util);
58
5
100
    unless ($prog) {
59
4
        $prog = $ENV{ uc($util) };
60    }
61
62    # never override the user. If a non-existent program is specified then
63    # the user is responsible for the consequences.
64
5
100
    if ( defined $prog ) {
65
2
        $conf->data->set( $util => $prog );
66
2
        $self->set_result('user defined');
67
2
        return 1;
68    }
69    else {
70
3
        $prog = check_progs( [@lex_defaults], $verbose );
71
3
100
        if ( !$prog ) {
72
1
            $self->set_result('no lex program was found');
73
1
            return;
74        }
75        else {
76
77
2
50
            if ( $conf->options->get('ask') ) {
78
2
50
                $prog = prompt( $prompt, $prog ? $prog : $conf->data->get($util) );
79            }
80
2
            my ( $stdout, $stderr, $ret ) = capture_output( $prog, '--version' );
81
82            # don't override the user even if the program they provided
83            # appears to be broken
84
2
50
50
33
            if ( $ret == -1 and !$conf->options->get('ask') ) {
85
86                # fall back to default
87
0
                $self->set_result('lex program does not exist or does not understand --version');
88
0
                return;
89            }
90            elsif ( $stdout =~ /f?lex .*? (\d+) \. (\d+) \. (\d+)/x ) {
91
92                # if '--version' returns a string assume that this is flex.
93                # flex calls it self by $0 so it will claim to be lex
94                # if invoked as `lex`
95
2
                my ( $prog_major, $prog_minor, $prog_patch ) = ( $1, $2, $3 );
96
2
                my $prog_version = "$1.$2.$3";
97
98                # is there a version requirement?
99
2
                my $req = $conf->options->get('flex_required');
100
2
50
                unless ( defined $req ) {
101
2
                    $req = $default_required;
102                }
103
2
50
                if ($req) {
104
2
                    my ( $rmajor, $rminor, $rpatch ) = ( $req =~ / ^ (\d+) \. (\d+) \. (\d+) $ /x );
105
2
50
50
33
12
                    if ( !defined $rmajor ) {
106
0
                        $self->set_result("could not understand flex version requirement");
107
0
                        return;
108                    }
109                    elsif (
110                        $prog_major < $rmajor
111                        or ( $prog_major == $rmajor
112                            and $prog_minor < $rminor )
113                        or ( $prog_major == $rmajor
114                            and $prog_minor == $rminor
115                            and $prog_patch < $rpatch )
116                        )
117                    {
118
0
                        $self->set_result( "found flex version $prog_version"
119                                . " but at least $rmajor.$rminor.$rpatch is required" );
120
0
                        return;
121                    }
122                    else {
123
2
                        1; # lack an explicit 'else' here
124                    }
125                }
126
2
                $conf->data->set( flex_version => $prog_version );
127
2
                $self->set_result("flex $prog_version");
128
2
                $conf->data->set( $util => $prog );
129
2
                return 1;
130            }
131            else {
132
0
                $self->set_result('lex program does not exist or does not understand --version');
133
0
                return;
134            }
135        }
136    }
137}
138
1391;
140
141# Local Variables:
142# mode: cperl
143# cperl-indent-level: 4
144# fill-column: 100
145# End:
146# vim: expandtab shiftwidth=4: