New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Fortran.pm in vendors/lib/FCM/System/Make/Build/FileType – NEMO

source: vendors/lib/FCM/System/Make/Build/FileType/Fortran.pm @ 10669

Last change on this file since 10669 was 10669, checked in by nicolasmartin, 5 years ago

Import latest FCM release from Github into the repository for testing
File size: 13.5 KB
Line 
1# ------------------------------------------------------------------------------
2# (C) British Crown Copyright 2006-17 Met Office.
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{block\s*data|module|program|submodule}imsx;
59my $RE_UNIT_CALL = qr{subroutine|function}imsx;
60my %RE           = (
61    DEP_O     => qr{\A\s*!\s*depends\s*on\s*:\s*($RE_FILE)}imsx,
62    DEP_USE   => qr{\A\s*use\s+($RE_NAME)}imsx,
63    DEP_SUBM  => qr{\A\s*submodule\s+\(($RE_NAME)\)}imsx,
64    INCLUDE   => qr{\#?\s*include\s*}imsx,
65    OMP_SENT  => qr{\A(\s*!\$\s+)?(.*)\z}imsx,
66    UNIT_ATTR => qr{\A\s*(?:(?:(?:impure\s+)?elemental|recursive|pure)\s+)+(.*)\z}imsx,
67    UNIT_BASE => qr{\A\s*($RE_UNIT_BASE)\s+($RE_NAME)\s*\z}imsx,
68    UNIT_CALL => qr{\A\s*($RE_UNIT_CALL)\s+($RE_NAME)\b}imsx,
69    UNIT_END  => qr{\A\s*(end)(?:\s+($RE_NAME)(?:\s+($RE_NAME))?)?\s*\z}imsx,
70    UNIT_SPEC => qr{\A\s*$RE_SPEC\b(.*)\z}imsx,
71);
72
73# Dependency types and extractors
74my %SOURCE_ANALYSE_DEP_OF = (
75    'f.module'  => \&_source_analyse_dep_module,
76    'include'   => \&_source_analyse_dep_include,
77    'o'         => sub { lc($_[0]) =~ $RE{DEP_O} }, # lc required for legacy
78    'o.special' => sub {},
79);
80# Alias
81my $TARGET = 'FCM::Context::Make::Build::Target';
82# Classes for tasks used by targets of this file type
83my %TASK_CLASS_OF = (
84    'compile'   => 'FCM::System::Make::Build::Task::Compile::Fortran',
85    'compile+'  => 'FCM::System::Make::Build::Task::Compile::Fortran::Extra',
86    'ext-iface' => 'FCM::System::Make::Build::Task::ExtractInterface',
87    'install'   => 'FCM::System::Make::Build::Task::Install',
88    'link'      => 'FCM::System::Make::Build::Task::Link::Fortran',
89);
90# Property suffices of output file extensions
91my %TARGET_EXT_OF = (
92    'bin'           => '.exe',
93    'f90-interface' => '.interface',
94    'f90-mod'       => '.mod',
95    'o'             => '.o',
96);
97
98sub new {
99    my ($class, $attrib_ref) = @_;
100    bless(
101        FCM::System::Make::Build::FileType->new({
102            id                         => 'fortran',
103            file_ext                   => $FILE_EXT,
104            source_analyse_always      => 1,
105            source_analyse_dep_of      => {%SOURCE_ANALYSE_DEP_OF},
106            source_analyse_more        => \&_source_analyse_more,
107            source_analyse_more_init   => \&_source_analyse_more_init,
108            source_to_targets          => \&_source_to_targets,
109            target_deps_filter         => \&_target_deps_filter,
110            target_file_ext_of         => {%TARGET_EXT_OF},
111            target_file_name_option_of => {'f90-mod' => q{}},
112            task_class_of              => {%TASK_CLASS_OF},
113            %{$attrib_ref},
114        }),
115        $class,
116    );
117}
118
119sub _source_analyse_more {
120    my ($line, $info_hash_ref, $state) = @_;
121
122    # End Interface
123    if ($state->{in_interface}) {
124        if ($line =~ qr{\A\s*end\s*interface\b}imsx) {
125            $state->{in_interface} = 0;
126        }
127        return 1;
128    }
129
130    # End Program Unit
131    if (@{$state->{stack}} && $line =~ qr{\A\s*end\b}imsx) {
132        my ($end, $type, $symbol) = lc($line) =~ $RE{UNIT_END};
133        if (!$end) {
134            return 1;
135        }
136        my ($top_type, $top_symbol) = @{$state->{stack}->[-1]};
137        if (!$type
138            || $top_type eq $type && (!$symbol || $top_symbol eq $symbol))
139        {
140            pop(@{$state->{stack}});
141            if ($state->{in_contains} && !@{$state->{stack}}) {
142                $state->{in_contains} = 0;
143            }
144        }
145        return 1;
146    }
147
148    # Interface/Contains
149    if ($line =~ qr{\A\s*contains\b}imsx) {
150        $state->{'in_contains'} = 1;
151        return 1;
152    }
153    if ($line =~ qr{\A\s*(?:abstract\s+)?interface\b}imsx) {
154        $state->{'in_interface'} = 1;
155        return 1;
156    }
157
158    # Program Unit
159    my ($type, $symbol) = _process_prog_unit($line);
160    if ($type) {
161        if (!@{$state->{stack}}) {
162            if ($type eq 'program') {
163                $info_hash_ref->{main} = 1;
164            }
165            $info_hash_ref->{symbols} ||= [];
166            push(@{$info_hash_ref->{symbols}}, [$type, $symbol]);
167        }
168        push(@{$state->{stack}}, [$type, $symbol]);
169        return 1;
170    }
171    return;
172}
173
174sub _source_analyse_more_init {
175    my ($info_ref, $state) = @_;
176    %{$info_ref} = (main => 0, symbols => []);
177    %{$state} = (in_contains => undef, in_interface => undef, stack => []);
178}
179
180# Reads information: extract an include dependency.
181sub _source_analyse_dep_include {
182    my ($line) = @_;
183    my ($omp_sentinel, $extracted);
184    ($omp_sentinel, $line) = $line =~ $RE{OMP_SENT};
185    ($extracted) = extract_delimited($line, q{'"}, $RE{INCLUDE});
186    if (!$extracted) {
187        return;
188    }
189    $extracted = substr($extracted, 1, length($extracted) - 2);
190    if ($omp_sentinel) {
191        $extracted = $OMP_PREFIX . $extracted;
192    }
193    $extracted;
194}
195
196# Reads information: extract a module dependency.
197sub _source_analyse_dep_module {
198    my ($line) = @_;
199    my ($omp_sentinel, $extracted, $can_analyse_more);
200    ($omp_sentinel, $line) = $line =~ $RE{OMP_SENT};
201    ($extracted) = lc($line) =~ $RE{DEP_USE};
202    if (!$extracted) {
203        ($extracted) = lc($line) =~ $RE{DEP_SUBM};
204        $can_analyse_more = 1;
205    }
206    if (!$extracted || grep {$_ eq $extracted} @INTRINSIC_MODULES) {
207        return;
208    }
209    if ($omp_sentinel) {
210        $extracted = $OMP_PREFIX . $extracted;
211    }
212    ($extracted, $can_analyse_more);
213}
214
215# Parse a statement for program unit header. Returns a list containing the type,
216# the symbol and the signature tokens of the program unit.
217sub _process_prog_unit {
218    my ($string) = @_;
219    my ($type, $symbol, @args) = (q{}, q{});
220    ($type, $symbol) = lc($string) =~ $RE{UNIT_BASE};
221    if ($type) {
222        $type = lc($type);
223        $type =~ s{\s*}{}gmsx;
224        return ($type, $symbol);
225    }
226    $string =~ s/$RE{UNIT_ATTR}/$1/;
227    my ($match) = $string =~ $RE{UNIT_SPEC};
228    if ($match) {
229        $string = $match;
230        if ($string =~ qr{\A \s* \(}msx) {
231            extract_bracketed($string);
232        }
233        elsif ($string =~ qr{\A \s* \*}msx) {
234            $string =~ s{\A \s* \* \d+ \s*}{}msx;
235        }
236    }
237    ($type, $symbol) = lc($string) =~ $RE{UNIT_CALL};
238    if (!$type) {
239        return;
240    }
241    return (lc($type), lc($symbol));
242}
243
244# Returns a list of targets for a given build source.
245sub _source_to_targets {
246    my ($attrib_ref, $source, $ext_hash_ref, $option_hash_ref) = @_;
247    my $key = basename($source->get_path());
248    my $TARGET_OF = sub {
249        my ($symbol, $type) = @_;
250        if (exists($option_hash_ref->{$type})) {
251            my $is_upper = index($option_hash_ref->{$type}, 'case=upper') >= 0;
252            $symbol = $is_upper ? uc($symbol) : lc($symbol);
253        }
254        $symbol . $ext_hash_ref->{$type};
255    };
256    my @deps = map {
257        my ($k, $type) = @{$_};
258        my $ext = $attrib_ref->{util}->file_ext($k);
259          $type eq 'f.module'   ? [$TARGET_OF->($k, 'f90-mod'), 'include', 1]
260        : $type eq 'o' && !$ext ? [$TARGET_OF->($k, 'o'), $type]
261        :                         [$k, $type]
262    } @{$source->get_deps()};
263    # All source files can be used as include files
264    my @targets = (
265        $TARGET->new(
266            {   category  => $TARGET->CT_INCLUDE,
267                deps      => [@deps],
268                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
269                key       => $key,
270                status_of => {'include' => $TARGET->ST_UNKNOWN},
271                task      => 'install',
272            }
273        ),
274    );
275    my ($ext, $root) = $attrib_ref->{util}->file_ext($key);
276    my $symbols_ref = $source->get_info_of()->{symbols};
277    # FIXME: hard code the handling of "*.inc" files as include files
278    if (!defined($symbols_ref) || !@{$symbols_ref} || $ext eq 'inc') {
279        return @targets;
280    }
281    my $key_of_o = $TARGET_OF->($symbols_ref->[0][1], 'o');
282    my @keys_of_mod;
283    for (grep {$_->[0] eq 'module'} @{$symbols_ref}) {
284        my ($type, $symbol) = @{$_};
285        my $key_of_mod = $TARGET_OF->($symbol, 'f90-mod');
286        my @include_deps = grep {$_->[1] eq 'include'} @deps;
287        push(
288            @targets,
289            $TARGET->new(
290                {   category      => $TARGET->CT_INCLUDE,
291                    deps          => [[$key_of_o, 'o']],
292                    dep_policy_of => {
293                        'include' => $TARGET->POLICY_CAPTURE,
294                        'o'       => $TARGET->POLICY_FILTER_IMMEDIATE,
295                    },
296                    key         => $key_of_mod,
297                    task        => 'compile+',
298                }
299            )
300        );
301        push(@keys_of_mod, $key_of_mod);
302    }
303    push(
304        @targets,
305        $TARGET->new(
306            {   category      => $TARGET->CT_O,
307                deps          => [@deps],
308                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
309                info_of       => {paths => []},
310                key           => $key_of_o,
311                task          => 'compile',
312                triggers      => \@keys_of_mod,
313            }
314        ),
315    );
316    if (grep {$_->[0] eq 'subroutine' || $_->[0] eq 'function'} @{$symbols_ref}) {
317        my $target_key = $root . $ext_hash_ref->{'f90-interface'};
318        push(
319            @targets,
320            $TARGET->new(
321                {   category      => $TARGET->CT_INCLUDE,
322                    deps          => [[$key_of_o, 'o'], grep {exists($_->[2])} @deps],
323                    dep_policy_of => {
324                        'include' => $TARGET->POLICY_FILTER_IMMEDIATE,
325                    },
326                    key           => $target_key,
327                    task          => 'ext-iface',
328                }
329            )
330        );
331    }
332    if ($source->get_info_of()->{main}) {
333        my @link_deps = grep {$_->[1] eq 'o' || $_->[1] eq 'o.special'} @deps;
334        push(
335            @targets,
336            $TARGET->new(
337                {   category      => $TARGET->CT_BIN,
338                    deps          => [[$key_of_o, 'o'], @link_deps],
339                    dep_policy_of => {
340                        'o'         => $TARGET->POLICY_CAPTURE,
341                        'o.special' => $TARGET->POLICY_CAPTURE,
342                    },
343                    info_of       => {
344                        paths => [], deps => {o => [], 'o.special' => []},
345                    },
346                    key           => $root . $ext_hash_ref->{bin},
347                    task          => 'link',
348                }
349            )
350        );
351    }
352    return @targets;
353}
354
355# If target's fc.flag-omp property is empty, remove !$OMP dependencies.
356# Otherwise, remove !$OMP sentinels from the dependencies.
357sub _target_deps_filter {
358    my ($attrib_ref, $target) = @_;
359    if ($target->get_prop_of()->{'fc.flag-omp'}) {
360        for my $dep_ref (@{$target->get_deps()}) {
361            if (index($dep_ref->[0], $OMP_PREFIX) == 0) {
362                substr($dep_ref->[0], 0, length($OMP_PREFIX), q{});
363            }
364        }
365    }
366    else {
367        $target->set_deps(
368            [grep {index($_->[0], $OMP_PREFIX) == -1} @{$target->get_deps()}],
369        );
370    }
371}
372
373# ------------------------------------------------------------------------------
3741;
375__END__
376
377=head1 NAME
378
379FCM::System::Make::Build::FileType::Fortran
380
381=head1 SYNOPSIS
382
383    use FCM::System::Make::Build::FileType::Fortran;
384    my $file_type_util = FCM::System::Make::Build::FileType::Fortran->new();
385
386    $file_type_util->source_analyse($source);
387
388    my @targets = $file_type_util->source_to_targets($m_ctx, $ctx, $source);
389
390=head1 DESCRIPTION
391
392A wrapper of
393L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType> with
394configurations to work with Fortran source files.
395
396=head1 TODO
397
398Combine the code with FCM::System::Make::Build::Task::ExtractInterface.
399
400=head1 COPYRIGHT
401
402(C) Crown copyright Met Office. All rights reserved.
403
404=cut
Note: See TracBrowser for help on using the repository browser.