File Coverage

File:config/auto/attributes.pm
Coverage:93.0%

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

config/auto/attributes.pm - Attributes detection

=head1 DESCRIPTION

Automagically detect what attributes, like HASATTRIBUTE_CONST, that
the compiler can support.

=cut
13
14package auto::attributes;
15
16
2
2
2
2
use strict;
17
2
2
2
2
use warnings;
18
19
2
2
2
2
use base qw(Parrot::Configure::Step);
20
21
2
2
2
2
use Parrot::Configure::Utils ();
22
2
2
2
2
use Parrot::BuildUtil;
23
24sub _init {
25
2
2
    my $self = shift;
26
2
    my %data;
27
2
    $data{description} = q{Detect compiler attributes};
28
2
    $data{result} = q{};
29
2
    return \%data;
30}
31
32our @potential_attributes = qw(
33    HASATTRIBUTE_CONST
34    HASATTRIBUTE_DEPRECATED
35    HASATTRIBUTE_FORMAT
36    HASATTRIBUTE_MALLOC
37    HASATTRIBUTE_NONNULL
38    HASATTRIBUTE_NORETURN
39    HASATTRIBUTE_PURE
40    HASATTRIBUTE_UNUSED
41    HASATTRIBUTE_WARN_UNUSED_RESULT
42    HASATTRIBUTE_HOT
43    HASATTRIBUTE_COLD
44    HASATTRIBUTE_NEVER_WORKS
45);
46# HASATTRIBUTE_NEVER_WORKS is at the end just to prove that it's possible to fail.
47
48sub runstep {
49
2
2
    my ( $self, $conf ) = @_;
50
51
2
    $conf->debug("\n");
52
53
2
    for my $maybe_attr (@potential_attributes) {
54
24
        $self->try_attr( $conf, $maybe_attr);
55    }
56
2
    return 1;
57}
58
59sub try_attr {
60
24
24
    my ( $self, $conf, $attr ) = @_;
61
62
24
    my $output_file = 'test.cco';
63
64
24
    $conf->debug("trying attribute '$attr'\n");
65
66
24
    my $cc = $conf->option_or_data('cc');
67
24
    $conf->cc_gen('config/auto/attributes/test_c.in');
68
69
24
    my $disable_warnings = '';
70
71    # work around msvc warning for unused variable
72
24
50
    if ( defined $conf->option_or_data('msvcversion') ) {
73
0
        $disable_warnings = '-wd4101';
74    }
75
76
24
    my $ccflags = $conf->data->get('ccflags');
77
24
    my $tryflags = "$ccflags -D$attr $disable_warnings";
78
79
24
    my $command_line = Parrot::Configure::Utils::_build_compile_command( $cc, $tryflags );
80
24
    $conf->debug(" ", $command_line, "\n");
81
82    # Don't use cc_build, because failure is expected.
83
24
    my $exit_code =
84        Parrot::Configure::Utils::_run_command( $command_line, $output_file, $output_file );
85
24
    $conf->debug(" exit code: $exit_code\n");
86
87
24
    $conf->cc_clean();
88
24
    $conf->data->set( $attr => !$exit_code | 0 );
89
90
24
100
    if ($exit_code) {
91
4
50
        unlink $output_file or die "Unable to unlink $output_file: $!";
92
4
        $conf->debug("Rejecting bogus attribute: $attr\n");
93
4
        return;
94    }
95
96
20
    my $output = Parrot::BuildUtil::slurp_file($output_file);
97
20
    $conf->debug(" output: $output\n");
98
99
20
50
    if ( $output !~ /error|warning/i ) {
100
20
        $conf->data->set( ccflags => $tryflags );
101
20
        my $ccflags = $conf->data->get("ccflags");
102
20
        $conf->debug(" ccflags: $ccflags\n");
103    }
104
20
50
    unlink $output_file or die "Unable to unlink $output_file: $!";
105
106
20
    return;
107}
108
1091;
110
111# Local Variables:
112# mode: cperl
113# cperl-indent-level: 4
114# fill-column: 100
115# End:
116# vim: expandtab shiftwidth=4: