File Coverage

File:config/inter/progs.pm
Coverage:93.7%

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

config/inter/progs.pm - C Compiler and Linker

=head1 DESCRIPTION

Asks the user which compiler, linker, shared library builder, C libraries,
lexical analyzer generator and parser generator to use. Also whether debugging
should be enabled.

=cut
14
15package inter::progs;
16
17
5
5
5
5
use strict;
18
5
5
5
5
use warnings;
19
20
5
5
5
5
use base qw(Parrot::Configure::Step);
21
22
5
5
5
5
use Parrot::Configure::Utils ':inter', ':auto';
23
24
25sub _init {
26
5
5
    my $self = shift;
27
5
    my %data;
28
5
    $data{description} = q{Determine what C compiler and linker to use};
29
5
    $data{result} = q{};
30
5
    return \%data;
31}
32
33sub runstep {
34
2
2
    my ( $self, $conf ) = @_;
35
36
2
    my $ask = _prepare_for_interactivity($conf);
37
38
2
    my $cc;
39
2
    ($conf, $cc) = _get_programs($conf, $ask);
40
41
2
    my $debug = _get_debug($conf, $ask);
42
43
2
    my $debug_validity = _is_debug_setting_valid($debug);
44
2
100
    return unless defined $debug_validity;
45
46
1
    $conf = _set_debug_and_warn($conf, $debug);
47
48    # Beware! Inside test_compiler(), cc_build() and cc_run() both silently
49    # reference the Parrot::Configure object ($conf) at its current state.
50
1
    test_compiler($conf, $cc);
51
52
1
    return 1;
53}
54
55sub _prepare_for_interactivity {
56
5
5
    my $conf = shift;
57
5
    my $ask = $conf->options->get('ask');
58
5
100
    if ($ask) {
59
4
        print <<'END';
60
61
62    Okay, I'm going to start by asking you a couple questions about your
63    compiler and linker. Default values are in square brackets; you can
64    hit ENTER to accept them. If you don't understand a question, the
65    default will usually work--they've been intuited from your Perl 5
66    configuration.
67
68END
69    }
70
5
    return $ask;
71}
72
73sub _get_programs {
74
5
5
    my ($conf, $ask) = @_;
75    # Set each variable individually so that hints files can use them as
76    # triggers to help pick the correct defaults for later answers.
77
5
    my ( $cc, $cxx, $link, $ld, $ccflags, $linkflags, $ldflags, $arflags);
78
5
    my ( $libs, $lex, $yacc, $ar );
79
5
    $cc = integrate( $conf->data->get('cc'), $conf->options->get('cc') );
80
5
100
    $cc = prompt( "What C compiler do you want to use?", $cc )
81        if $ask;
82
5
    $conf->data->set( cc => $cc );
83
84
5
    $link = integrate( $conf->data->get('link'), $conf->options->get('link') );
85
5
100
    $link = prompt( "How about your linker?", $link ) if $ask;
86
5
    $conf->data->set( link => $link );
87
88
5
    $ld = integrate( $conf->data->get('ld'), $conf->options->get('ld') );
89
5
100
    $ld = prompt( "What program do you want to use to build shared libraries?", $ld ) if $ask;
90
5
    $conf->data->set( ld => $ld );
91
92
5
    $ccflags = integrate( $conf->data->get('ccflags'),
93        $conf->options->get('ccflags') );
94
95    # Remove some perl5-isms.
96
5
    $ccflags =~ s/-D((PERL|HAVE)_\w+\s*|USE_PERLIO)//g;
97
5
    $ccflags =~ s/-fno-strict-aliasing//g;
98
5
    $ccflags =~ s/-fnative-struct//g;
99
5
100
    $ccflags = prompt( "What flags should your C compiler receive?", $ccflags )
100        if $ask;
101
5
    $conf->data->set( ccflags => $ccflags );
102
103
5
    $conf->debug("\nccflags: $ccflags\n");
104
105
5
    $ar = integrate( $conf->data->get('ar'), $conf->options->get('ar') );
106
5
100
    $ar = prompt( "What archiver do you want to use to build static libraries?", $ar ) if $ask;
107
5
    $conf->data->set( ar => $ar );
108
109
5
    $arflags = integrate( $conf->data->get('arflags'), $conf->options->get('arflags') );
110
5
100
    $arflags = prompt( "What flags should your archiver receive to create static libraries?",
111                $arflags) if $ask;
112
5
    $conf->data->set( arflags => $arflags );
113
114
115
5
    $linkflags = $conf->data->get('linkflags');
116    # Remove the path to the Perl library (from Win32 config).
117    # See TT #854.
118
5
    $linkflags =~ s/-libpath:\S+//g;
119
5
    $linkflags = integrate( $linkflags, $conf->options->get('linkflags') );
120
5
100
    $linkflags = prompt( "And flags for your linker?", $linkflags ) if $ask;
121
5
    $conf->data->set( linkflags => $linkflags );
122
123
5
    $ldflags = $conf->data->get('ldflags');
124    # For substitution below, see comment for $linkflags above.
125
5
    $ldflags =~ s/-libpath:\S+//g;
126
5
    $ldflags = integrate( $ldflags, $conf->options->get('ldflags') );
127
5
100
    $ldflags = prompt( "And your $ld flags for building shared libraries?", $ldflags )
128        if $ask;
129
5
    $conf->data->set( ldflags => $ldflags );
130
131
5
    $libs = $conf->data->get('libs');
132
50
50
    $libs = join q{ },
133
5
        grep { $conf->data->get('OSNAME_provisional') =~ /VMS|MSWin/ || !/^-l(c|gdbm(_compat)?|dbm|ndbm|db)$/ }
134        split( q{ }, $libs );
135
5
    $libs = integrate( $libs, $conf->options->get('libs') );
136
5
100
    $libs = prompt( "What libraries should your C compiler use?", $libs )
137        if $ask;
138
5
    $conf->data->set( libs => $libs );
139
140
5
    $cxx = integrate( $conf->data->get('cxx'), $conf->options->get('cxx') );
141
5
100
    $cxx = prompt( "What C++ compiler do you want to use?", $cxx ) if $ask;
142
5
    $conf->data->set( cxx => $cxx );
143
5
    return ($conf, $cc);
144}
145
146sub _get_debug {
147
5
5
    my ($conf, $ask) = @_;
148
5
    my $debug = 'n';
149
5
100
    $debug = 'y' if $conf->options->get('debugging');
150
5
100
    $debug = prompt( "Do you want a debugging build of Parrot?", $debug )
151        if $ask;
152
5
    return $debug;
153}
154
155sub _is_debug_setting_valid {
156
5
5
    my $debug = shift;
157
5
100
    ( $debug =~ /^[yn]$/i ) ? return 1 : return;
158}
159
160sub _set_debug_and_warn {
161
4
4
    my ($conf, $debug) = @_;
162
4
100
    if ( $debug =~ /n/i ) {
163
1
        $conf->data->set(
164            cc_debug => '',
165            link_debug => '',
166            ld_debug => ''
167        );
168    }
169
170    # This one isn't prompted for above. I don't know why.
171
4
    my $ccwarn = integrate( $conf->data->get('ccwarn'), $conf->options->get('ccwarn') );
172
4
    $conf->data->set( ccwarn => $ccwarn );
173
4
    return $conf;
174}
175
176sub test_compiler {
177
1
1
    my ($conf, $cc) = @_;
178
179
1
50
    open( my $out_fh, '>', "test_$$.c" )
180        or die "Unable to open 'test_$$.c': $@\n";
181
1
1
    print {$out_fh} <<END_C;
182int main() {
183    return 0;
184}
185END_C
186
1
    close $out_fh;
187
188
1
1
1
50
    unless ( eval { $conf->cc_build(); 1 } ) {
189
0
        warn "Compilation failed with '$cc'\n";
190
0
        exit 1;
191    }
192
193
1
1
1
50
    unless ( eval { $conf->cc_run(); 1 } ) {
194
0
0
        warn $@ if $@;
195
0
        exit 1;
196    }
197}
198
1991;
200
201# Local Variables:
202# mode: cperl
203# cperl-indent-level: 4
204# fill-column: 100
205# End:
206# vim: expandtab shiftwidth=4: