source: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Fortran.pm @ 5129

Last change on this file since 5129 was 5129, checked in by abarral, 8 weeks ago

Re-add removed by mistake fcm
File size: 14.2 KB
Line 
1# ------------------------------------------------------------------------------
2# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
3#
4# This file is part of FCM, tools for managing and building source code.
5#
6# FCM is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10#
11# FCM is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with FCM. If not, see <http://www.gnu.org/licenses/>.
18# ------------------------------------------------------------------------------
19use strict;
20use warnings;
21
22# ------------------------------------------------------------------------------
23package FCM::System::Make::Build::FileType::Fortran;
24use base qw{FCM::System::Make::Build::FileType};
25
26use FCM::Context::Make::Build;    # for FCM::Context::Make::Build::Target
27use FCM::System::Make::Build::Task::Compile::Fortran;
28use FCM::System::Make::Build::Task::ExtractInterface;
29use FCM::System::Make::Build::Task::Install;
30use FCM::System::Make::Build::Task::Link::Fortran;
31use File::Basename qw{basename};
32use Text::Balanced qw{extract_bracketed extract_delimited};
33
34# Recommended file extensions of this utility
35our $FILE_EXT = '.F .F90 .F95 .FOR .FTN .f .f90 .f95 .for .ftn .inc';
36
37# List of Fortran intrinsic modules
38our @INTRINSIC_MODULES = qw{
39    ieee_arithmetic
40    ieee_exceptions
41    ieee_features
42    iso_c_binding
43    iso_fortran_env
44    omp_lib
45    omp_lib_kinds
46};
47
48# Prefix for dependency name that is only applicable under OMP
49our $OMP_PREFIX = '!$';
50
51# Regular expressions
52my $RE_FILE = qr{[\w\-+.]+}imsx;
53my $RE_NAME = qr{[A-Za-z]\w*}imsx;
54my $RE_SPEC = qr{
55    character|class|complex|double\s*complex|double\s*precision|integer|
56    logical|procedure|real|type
57}imsx;
58my $RE_UNIT_BASE = qr{
59    block\s*data|
60    module(?!\s*(?:function|subroutine|procedure)\s+)|
61    program|
62}imsx;
63my $RE_UNIT_CALL = qr{subroutine|function}imsx;
64my %RE           = (
65    DEP_O     => qr{\A\s*!\s*depends\s*on\s*:\s*($RE_FILE)}imsx,
66    DEP_USE   => qr{\A\s*use\s+($RE_NAME)}imsx,
67    DEP_SUBM  => qr{\A\s*submodule\s+\(($RE_NAME)\)}imsx,
68    INCLUDE   => qr{\#?\s*include\s*}imsx,
69    OMP_SENT  => qr{\A(\s*!\$\s+)?(.*)\z}imsx,
70    UNIT_ATTR => qr{\A\s*(?:(?:(?:impure\s+)?elemental|recursive|pure)\s+)+(.*)\z}imsx,
71    UNIT_BASE => qr{\A\s*($RE_UNIT_BASE)\s+($RE_NAME)\b}imsx,
72    UNIT_SUBM => qr{\A\s*(submodule)\s*\(($RE_NAME)\)\s*($RE_NAME)\b}imsx,
73    UNIT_CALL => qr{\A\s*($RE_UNIT_CALL)\s+($RE_NAME)\b}imsx,
74    UNIT_END  => qr{\A\s*(end)(?:\s+($RE_NAME)(?:\s+($RE_NAME))?)?\b}imsx,
75    UNIT_SPEC => qr{\A\s*$RE_SPEC\b(.*)\z}imsx,
76);
77
78# Dependency types and extractors
79my %SOURCE_ANALYSE_DEP_OF = (
80    'f.module'  => \&_source_analyse_dep_module,
81    'include'   => \&_source_analyse_dep_include,
82    'o'         => sub { lc($_[0]) =~ $RE{DEP_O} }, # lc required for legacy
83    'o.special' => sub {},
84);
85# Alias
86my $TARGET = 'FCM::Context::Make::Build::Target';
87# Classes for tasks used by targets of this file type
88my %TASK_CLASS_OF = (
89    'compile'   => 'FCM::System::Make::Build::Task::Compile::Fortran',
90    'compile+'  => 'FCM::System::Make::Build::Task::Compile::Fortran::Extra',
91    'ext-iface' => 'FCM::System::Make::Build::Task::ExtractInterface',
92    'install'   => 'FCM::System::Make::Build::Task::Install',
93    'link'      => 'FCM::System::Make::Build::Task::Link::Fortran',
94);
95# Property suffices of output file extensions
96my %TARGET_EXT_OF = (
97    'bin'           => '.exe',
98    'f90-interface' => '.interface',
99    'f90-mod'       => '.mod',
100    'o'             => '.o',
101);
102
103sub new {
104    my ($class, $attrib_ref) = @_;
105    bless(
106        FCM::System::Make::Build::FileType->new({
107            id                         => 'fortran',
108            file_ext                   => $FILE_EXT,
109            source_analyse_always      => 1,
110            source_analyse_dep_of      => {%SOURCE_ANALYSE_DEP_OF},
111            source_analyse_more        => \&_source_analyse_more,
112            source_analyse_more_init   => \&_source_analyse_more_init,
113            source_to_targets          => \&_source_to_targets,
114            target_deps_filter         => \&_target_deps_filter,
115            target_file_ext_of         => {%TARGET_EXT_OF},
116            target_file_name_option_of => {'f90-mod' => q{}},
117            task_class_of              => {%TASK_CLASS_OF},
118            %{$attrib_ref},
119        }),
120        $class,
121    );
122}
123
124sub _source_analyse_more {
125    my ($line, $info_hash_ref, $state) = @_;
126
127    # End Interface
128    if ($state->{in_interface}) {
129        if ($line =~ qr{\A\s*end\s*interface\b}imsx) {
130            $state->{in_interface} = 0;
131        }
132        return 1;
133    }
134
135    # End Program Unit
136    if (@{$state->{stack}} && $line =~ qr{\A\s*end\b}imsx) {
137        my ($end, $type, $symbol) = lc($line) =~ $RE{UNIT_END};
138        if (!$end) {
139            return 1;
140        }
141        my ($top_type, $top_symbol) = @{$state->{stack}->[-1]};
142        if (!$type
143            || $top_type eq $type && (!$symbol || $top_symbol eq $symbol))
144        {
145            pop(@{$state->{stack}});
146            if ($state->{in_contains} && !@{$state->{stack}}) {
147                $state->{in_contains} = 0;
148            }
149        }
150        return 1;
151    }
152
153    # Interface/Contains
154    if ($line =~ qr{\A\s*contains\b}imsx) {
155        $state->{'in_contains'} = 1;
156        return 1;
157    }
158    if ($line =~ qr{\A\s*(?:abstract\s+)?interface\b}imsx) {
159        $state->{'in_interface'} = 1;
160        return 1;
161    }
162
163    # Program Unit
164    my ($type, $symbol, @extras) = _process_prog_unit($line);
165    if ($type) {
166        if (!@{$state->{stack}}) {
167            if ($type eq 'program') {
168                $info_hash_ref->{main} = 1;
169            }
170            $info_hash_ref->{symbols} ||= [];
171            push(@{$info_hash_ref->{symbols}}, [$type, $symbol, @extras]);
172        }
173        push(@{$state->{stack}}, [$type, $symbol]);
174        return 1;
175    }
176    return;
177}
178
179sub _source_analyse_more_init {
180    my ($info_ref, $state) = @_;
181    %{$info_ref} = (main => 0, symbols => []);
182    %{$state} = (in_contains => undef, in_interface => undef, stack => []);
183}
184
185# Reads information: extract an include dependency.
186sub _source_analyse_dep_include {
187    my ($line) = @_;
188    my ($omp_sentinel, $extracted);
189    ($omp_sentinel, $line) = $line =~ $RE{OMP_SENT};
190    ($extracted) = extract_delimited($line, q{'"}, $RE{INCLUDE});
191    if (!$extracted) {
192        return;
193    }
194    $extracted = substr($extracted, 1, length($extracted) - 2);
195    if ($omp_sentinel) {
196        $extracted = $OMP_PREFIX . $extracted;
197    }
198    $extracted;
199}
200
201# Reads information: extract a module dependency.
202sub _source_analyse_dep_module {
203    my ($line) = @_;
204    my ($omp_sentinel, $extracted, $can_analyse_more);
205    ($omp_sentinel, $line) = $line =~ $RE{OMP_SENT};
206    ($extracted) = lc($line) =~ $RE{DEP_USE};
207    if (!$extracted) {
208        ($extracted) = lc($line) =~ $RE{DEP_SUBM};
209        $can_analyse_more = 1;
210    }
211    if (!$extracted || grep {$_ eq $extracted} @INTRINSIC_MODULES) {
212        return;
213    }
214    if ($omp_sentinel) {
215        $extracted = $OMP_PREFIX . $extracted;
216    }
217    ($extracted, $can_analyse_more);
218}
219
220# Parse a statement for program unit header. Returns a list containing the type,
221# the symbol and the signature tokens of the program unit.
222sub _process_prog_unit {
223    my ($string) = @_;
224    my ($type, $symbol, $symbol_parent) = (q{}, q{}, q{});
225    ($type, $symbol) = lc($string) =~ $RE{UNIT_BASE};
226    if ($type) {
227        $type =~ s{\s*}{}gmsx;
228        return ($type, $symbol);
229    }
230    ($type, $symbol_parent, $symbol) = lc($string) =~ $RE{UNIT_SUBM};
231    if ($type) {
232        return ($type, $symbol, $symbol_parent);
233    }
234    $string =~ s/$RE{UNIT_ATTR}/$1/;
235    my ($match) = $string =~ $RE{UNIT_SPEC};
236    if ($match) {
237        $string = $match;
238        if ($string =~ qr{\A \s* \(}msx) {
239            extract_bracketed($string);
240        }
241        elsif ($string =~ qr{\A \s* \*}msx) {
242            $string =~ s{\A \s* \* \d+ \s*}{}msx;
243        }
244    }
245    ($type, $symbol) = lc($string) =~ $RE{UNIT_CALL};
246    if (!$type) {
247        return;
248    }
249    return (lc($type), lc($symbol));
250}
251
252# Returns a list of targets for a given build source.
253sub _source_to_targets {
254    my ($attrib_ref, $source, $ext_hash_ref, $option_hash_ref) = @_;
255    my $key = basename($source->get_path());
256    my $TARGET_OF = sub {
257        my ($symbol, $type) = @_;
258        if (exists($option_hash_ref->{$type})) {
259            my $is_upper = index($option_hash_ref->{$type}, 'case=upper') >= 0;
260            $symbol = $is_upper ? uc($symbol) : lc($symbol);
261        }
262        $symbol . $ext_hash_ref->{$type};
263    };
264    my @deps = map {
265        my ($k, $type) = @{$_};
266        my $ext = $attrib_ref->{util}->file_ext($k);
267          $type eq 'f.module'   ? [$TARGET_OF->($k, 'f90-mod'), 'include', 1]
268        : $type eq 'o' && !$ext ? [$TARGET_OF->($k, 'o'), $type]
269        :                         [$k, $type]
270    } @{$source->get_deps()};
271    # All source files can be used as include files
272    my @targets = (
273        $TARGET->new(
274            {   category  => $TARGET->CT_INCLUDE,
275                deps      => [@deps],
276                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
277                key       => $key,
278                status_of => {'include' => $TARGET->ST_UNKNOWN},
279                task      => 'install',
280            }
281        ),
282    );
283    my ($ext, $root) = $attrib_ref->{util}->file_ext($key);
284    # @{$symbols_ref} contains a list of [$type, $symbol, $symbol_parent]
285    # where $type is the program unit type
286    #       $symbol is the program unit symbol
287    #       $symbol_parent is the parent program unit symbol, e.g. name of
288    #       parent module of a submodule
289    my $symbols_ref = $source->get_info_of()->{symbols};
290    # FIXME: hard code the handling of "*.inc" files as include files
291    if (!defined($symbols_ref) || !@{$symbols_ref} || $ext eq 'inc') {
292        return @targets;
293    }
294    my $key_of_o = $TARGET_OF->($symbols_ref->[0][1], 'o');
295    my @keys_of_mod;
296    for (grep {$_->[0] eq 'module'} @{$symbols_ref}) {
297        my ($type, $symbol) = @{$_};
298        my $key_of_mod = $TARGET_OF->($symbol, 'f90-mod');
299        my @include_deps = grep {$_->[1] eq 'include'} @deps;
300        push(
301            @targets,
302            $TARGET->new(
303                {   category      => $TARGET->CT_INCLUDE,
304                    deps          => [[$key_of_o, 'o']],
305                    dep_policy_of => {
306                        'include' => $TARGET->POLICY_CAPTURE,
307                        'o'       => $TARGET->POLICY_FILTER_IMMEDIATE,
308                    },
309                    key         => $key_of_mod,
310                    task        => 'compile+',
311                }
312            )
313        );
314        push(@keys_of_mod, $key_of_mod);
315    }
316    my @symbol_parents = map {
317        scalar(@{$_}) > 2 ? $TARGET_OF->($_->[2], 'o') : ();
318    } @{$symbols_ref};
319    push(
320        @targets,
321        $TARGET->new(
322            {   category      => $TARGET->CT_O,
323                deps          => [@deps],
324                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
325                info_of       => {paths => [], parents => \@symbol_parents},
326                key           => $key_of_o,
327                task          => 'compile',
328                triggers      => \@keys_of_mod,
329            }
330        ),
331    );
332    if (grep {$_->[0] eq 'subroutine' || $_->[0] eq 'function'} @{$symbols_ref}) {
333        my $target_key = $root . $ext_hash_ref->{'f90-interface'};
334        push(
335            @targets,
336            $TARGET->new(
337                {   category      => $TARGET->CT_INCLUDE,
338                    deps          => [[$key_of_o, 'o'], grep {exists($_->[2])} @deps],
339                    dep_policy_of => {
340                        'include' => $TARGET->POLICY_FILTER_IMMEDIATE,
341                    },
342                    key           => $target_key,
343                    task          => 'ext-iface',
344                }
345            )
346        );
347    }
348    if ($source->get_info_of()->{main}) {
349        my @link_deps = grep {$_->[1] eq 'o' || $_->[1] eq 'o.special'} @deps;
350        push(
351            @targets,
352            $TARGET->new(
353                {   category      => $TARGET->CT_BIN,
354                    deps          => [[$key_of_o, 'o'], @link_deps],
355                    dep_policy_of => {
356                        'o'         => $TARGET->POLICY_CAPTURE,
357                        'o.special' => $TARGET->POLICY_CAPTURE,
358                    },
359                    info_of       => {
360                        paths => [], deps => {o => [], 'o.special' => []},
361                    },
362                    key           => $root . $ext_hash_ref->{bin},
363                    task          => 'link',
364                }
365            )
366        );
367    }
368    return @targets;
369}
370
371# If target's fc.flag-omp property is empty, remove !$OMP dependencies.
372# Otherwise, remove !$OMP sentinels from the dependencies.
373sub _target_deps_filter {
374    my ($attrib_ref, $target) = @_;
375    if ($target->get_prop_of()->{'fc.flag-omp'}) {
376        for my $dep_ref (@{$target->get_deps()}) {
377            if (index($dep_ref->[0], $OMP_PREFIX) == 0) {
378                substr($dep_ref->[0], 0, length($OMP_PREFIX), q{});
379            }
380        }
381    }
382    else {
383        $target->set_deps(
384            [grep {index($_->[0], $OMP_PREFIX) == -1} @{$target->get_deps()}],
385        );
386    }
387}
388
389# ------------------------------------------------------------------------------
3901;
391__END__
392
393=head1 NAME
394
395FCM::System::Make::Build::FileType::Fortran
396
397=head1 SYNOPSIS
398
399    use FCM::System::Make::Build::FileType::Fortran;
400    my $file_type_util = FCM::System::Make::Build::FileType::Fortran->new();
401
402    $file_type_util->source_analyse($source);
403
404    my @targets = $file_type_util->source_to_targets($m_ctx, $ctx, $source);
405
406=head1 DESCRIPTION
407
408A wrapper of
409L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType> with
410configurations to work with Fortran source files.
411
412=head1 TODO
413
414Combine the code with FCM::System::Make::Build::Task::ExtractInterface.
415
416=head1 COPYRIGHT
417
418Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
419
420=cut
Note: See TracBrowser for help on using the repository browser.