Bug Summary

File:build/gcc/fortran/trans-decl.cc
Warning:line 4981, column 15
1st function call argument is an uninitialized value

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-suse-linux -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name trans-decl.cc -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/15.0.7 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/backward -internal-isystem /usr/lib64/clang/15.0.7/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2023-03-27-141847-20772-1/report-ZE8YqH.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc
<
1/* Backend function setup
2 Copyright (C) 2002-2023 Free Software Foundation, Inc.
3 Contributed by Paul Brook
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21/* trans-decl.cc -- Handling of backend function and variable decls, etc */
22
23#include "config.h"
24#include "system.h"
25#include "coretypes.h"
26#include "target.h"
27#include "function.h"
28#include "tree.h"
29#include "gfortran.h"
30#include "gimple-expr.h" /* For create_tmp_var_raw. */
31#include "trans.h"
32#include "stringpool.h"
33#include "cgraph.h"
34#include "fold-const.h"
35#include "stor-layout.h"
36#include "varasm.h"
37#include "attribs.h"
38#include "dumpfile.h"
39#include "toplev.h" /* For announce_function. */
40#include "debug.h"
41#include "constructor.h"
42#include "trans-types.h"
43#include "trans-array.h"
44#include "trans-const.h"
45/* Only for gfc_trans_code. Shouldn't need to include this. */
46#include "trans-stmt.h"
47#include "gomp-constants.h"
48#include "gimplify.h"
49#include "omp-general.h"
50#include "attr-fnspec.h"
51
52#define MAX_LABEL_VALUE99999 99999
53
54
55/* Holds the result of the function if no result variable specified. */
56
57static GTY(()) tree current_fake_result_decl;
58static GTY(()) tree parent_fake_result_decl;
59
60
61/* Holds the variable DECLs for the current function. */
62
63static GTY(()) tree saved_function_decls;
64static GTY(()) tree saved_parent_function_decls;
65
66/* Holds the variable DECLs that are locals. */
67
68static GTY(()) tree saved_local_decls;
69
70/* The namespace of the module we're currently generating. Only used while
71 outputting decls for module variables. Do not rely on this being set. */
72
73static gfc_namespace *module_namespace;
74
75/* The currently processed procedure symbol. */
76static gfc_symbol* current_procedure_symbol = NULL__null;
77
78/* The currently processed module. */
79static struct module_htab_entry *cur_module;
80
81/* With -fcoarray=lib: For generating the registering call
82 of static coarrays. */
83static bool has_coarray_vars;
84static stmtblock_t caf_init_block;
85
86
87/* List of static constructor functions. */
88
89tree gfc_static_ctors;
90
91
92/* Whether we've seen a symbol from an IEEE module in the namespace. */
93static int seen_ieee_symbol;
94
95/* Function declarations for builtin library functions. */
96
97tree gfor_fndecl_pause_numeric;
98tree gfor_fndecl_pause_string;
99tree gfor_fndecl_stop_numeric;
100tree gfor_fndecl_stop_string;
101tree gfor_fndecl_error_stop_numeric;
102tree gfor_fndecl_error_stop_string;
103tree gfor_fndecl_runtime_error;
104tree gfor_fndecl_runtime_error_at;
105tree gfor_fndecl_runtime_warning_at;
106tree gfor_fndecl_os_error_at;
107tree gfor_fndecl_generate_error;
108tree gfor_fndecl_set_args;
109tree gfor_fndecl_set_fpe;
110tree gfor_fndecl_set_options;
111tree gfor_fndecl_set_convert;
112tree gfor_fndecl_set_record_marker;
113tree gfor_fndecl_set_max_subrecord_length;
114tree gfor_fndecl_ctime;
115tree gfor_fndecl_fdate;
116tree gfor_fndecl_ttynam;
117tree gfor_fndecl_in_pack;
118tree gfor_fndecl_in_unpack;
119tree gfor_fndecl_associated;
120tree gfor_fndecl_system_clock4;
121tree gfor_fndecl_system_clock8;
122tree gfor_fndecl_ieee_procedure_entry;
123tree gfor_fndecl_ieee_procedure_exit;
124
125/* Coarray run-time library function decls. */
126tree gfor_fndecl_caf_init;
127tree gfor_fndecl_caf_finalize;
128tree gfor_fndecl_caf_this_image;
129tree gfor_fndecl_caf_num_images;
130tree gfor_fndecl_caf_register;
131tree gfor_fndecl_caf_deregister;
132tree gfor_fndecl_caf_get;
133tree gfor_fndecl_caf_send;
134tree gfor_fndecl_caf_sendget;
135tree gfor_fndecl_caf_get_by_ref;
136tree gfor_fndecl_caf_send_by_ref;
137tree gfor_fndecl_caf_sendget_by_ref;
138tree gfor_fndecl_caf_sync_all;
139tree gfor_fndecl_caf_sync_memory;
140tree gfor_fndecl_caf_sync_images;
141tree gfor_fndecl_caf_stop_str;
142tree gfor_fndecl_caf_stop_numeric;
143tree gfor_fndecl_caf_error_stop;
144tree gfor_fndecl_caf_error_stop_str;
145tree gfor_fndecl_caf_atomic_def;
146tree gfor_fndecl_caf_atomic_ref;
147tree gfor_fndecl_caf_atomic_cas;
148tree gfor_fndecl_caf_atomic_op;
149tree gfor_fndecl_caf_lock;
150tree gfor_fndecl_caf_unlock;
151tree gfor_fndecl_caf_event_post;
152tree gfor_fndecl_caf_event_wait;
153tree gfor_fndecl_caf_event_query;
154tree gfor_fndecl_caf_fail_image;
155tree gfor_fndecl_caf_failed_images;
156tree gfor_fndecl_caf_image_status;
157tree gfor_fndecl_caf_stopped_images;
158tree gfor_fndecl_caf_form_team;
159tree gfor_fndecl_caf_change_team;
160tree gfor_fndecl_caf_end_team;
161tree gfor_fndecl_caf_sync_team;
162tree gfor_fndecl_caf_get_team;
163tree gfor_fndecl_caf_team_number;
164tree gfor_fndecl_co_broadcast;
165tree gfor_fndecl_co_max;
166tree gfor_fndecl_co_min;
167tree gfor_fndecl_co_reduce;
168tree gfor_fndecl_co_sum;
169tree gfor_fndecl_caf_is_present;
170tree gfor_fndecl_caf_random_init;
171
172
173/* Math functions. Many other math functions are handled in
174 trans-intrinsic.cc. */
175
176gfc_powdecl_list gfor_fndecl_math_powi[4][3];
177tree gfor_fndecl_math_ishftc4;
178tree gfor_fndecl_math_ishftc8;
179tree gfor_fndecl_math_ishftc16;
180
181
182/* String functions. */
183
184tree gfor_fndecl_compare_string;
185tree gfor_fndecl_concat_string;
186tree gfor_fndecl_string_len_trim;
187tree gfor_fndecl_string_index;
188tree gfor_fndecl_string_scan;
189tree gfor_fndecl_string_verify;
190tree gfor_fndecl_string_trim;
191tree gfor_fndecl_string_minmax;
192tree gfor_fndecl_adjustl;
193tree gfor_fndecl_adjustr;
194tree gfor_fndecl_select_string;
195tree gfor_fndecl_compare_string_char4;
196tree gfor_fndecl_concat_string_char4;
197tree gfor_fndecl_string_len_trim_char4;
198tree gfor_fndecl_string_index_char4;
199tree gfor_fndecl_string_scan_char4;
200tree gfor_fndecl_string_verify_char4;
201tree gfor_fndecl_string_trim_char4;
202tree gfor_fndecl_string_minmax_char4;
203tree gfor_fndecl_adjustl_char4;
204tree gfor_fndecl_adjustr_char4;
205tree gfor_fndecl_select_string_char4;
206
207
208/* Conversion between character kinds. */
209tree gfor_fndecl_convert_char1_to_char4;
210tree gfor_fndecl_convert_char4_to_char1;
211
212
213/* Other misc. runtime library functions. */
214tree gfor_fndecl_iargc;
215tree gfor_fndecl_kill;
216tree gfor_fndecl_kill_sub;
217tree gfor_fndecl_is_contiguous0;
218
219
220/* Intrinsic functions implemented in Fortran. */
221tree gfor_fndecl_sc_kind;
222tree gfor_fndecl_si_kind;
223tree gfor_fndecl_sr_kind;
224
225/* BLAS gemm functions. */
226tree gfor_fndecl_sgemm;
227tree gfor_fndecl_dgemm;
228tree gfor_fndecl_cgemm;
229tree gfor_fndecl_zgemm;
230
231/* RANDOM_INIT function. */
232tree gfor_fndecl_random_init; /* libgfortran, 1 image only. */
233
234static void
235gfc_add_decl_to_parent_function (tree decl)
236{
237 gcc_assert (decl)((void)(!(decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 237, __FUNCTION__), 0 : 0));
238 DECL_CONTEXT (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 238, __FUNCTION__))->decl_minimal.context) = DECL_CONTEXT (current_function_decl)((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 238, __FUNCTION__))->decl_minimal.context);
239 DECL_NONLOCAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 239, __FUNCTION__))->decl_common.nonlocal_flag) = 1;
240 DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 240, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 240, __FUNCTION__))->common.chain)) = saved_parent_function_decls;
241 saved_parent_function_decls = decl;
242}
243
244void
245gfc_add_decl_to_function (tree decl)
246{
247 gcc_assert (decl)((void)(!(decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 247, __FUNCTION__), 0 : 0));
248 TREE_USED (decl)((decl)->base.used_flag) = 1;
249 DECL_CONTEXT (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 249, __FUNCTION__))->decl_minimal.context) = current_function_decl;
250 DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 250, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 250, __FUNCTION__))->common.chain)) = saved_function_decls;
251 saved_function_decls = decl;
252}
253
254static void
255add_decl_as_local (tree decl)
256{
257 gcc_assert (decl)((void)(!(decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 257, __FUNCTION__), 0 : 0));
258 TREE_USED (decl)((decl)->base.used_flag) = 1;
259 DECL_CONTEXT (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 259, __FUNCTION__))->decl_minimal.context) = current_function_decl;
260 DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 260, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 260, __FUNCTION__))->common.chain)) = saved_local_decls;
261 saved_local_decls = decl;
262}
263
264
265/* Build a backend label declaration. Set TREE_USED for named labels.
266 The context of the label is always the current_function_decl. All
267 labels are marked artificial. */
268
269tree
270gfc_build_label_decl (tree label_id)
271{
272 /* 2^32 temporaries should be enough. */
273 static unsigned int tmp_num = 1;
274 tree label_decl;
275 char *label_name;
276
277 if (label_id == NULL_TREE(tree) __null)
278 {
279 /* Build an internal label name. */
280 ASM_FORMAT_PRIVATE_NAME (label_name, "L", tmp_num++)do { const char *const name_ = ("L"); char *const output_ = (
label_name) = (char *) __builtin_alloca(strlen (name_) + 32);
sprintf (output_, "%s.%lu", name_, (unsigned long)(tmp_num++
)); } while (0);
281 label_id = get_identifier (label_name)(__builtin_constant_p (label_name) ? get_identifier_with_length
((label_name), strlen (label_name)) : get_identifier (label_name
));
282 }
283 else
284 label_name = NULL__null;
285
286 /* Build the LABEL_DECL node. Labels have no type. */
287 label_decl = build_decl (input_location,
288 LABEL_DECL, label_id, void_type_nodeglobal_trees[TI_VOID_TYPE]);
289 DECL_CONTEXT (label_decl)((contains_struct_check ((label_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 289, __FUNCTION__))->decl_minimal.context) = current_function_decl;
290 SET_DECL_MODE (label_decl, VOIDmode)((contains_struct_check ((label_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 290, __FUNCTION__))->decl_common.mode = (((void) 0, E_VOIDmode
)));
291
292 /* We always define the label as used, even if the original source
293 file never references the label. We don't want all kinds of
294 spurious warnings for old-style Fortran code with too many
295 labels. */
296 TREE_USED (label_decl)((label_decl)->base.used_flag) = 1;
297
298 DECL_ARTIFICIAL (label_decl)((contains_struct_check ((label_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 298, __FUNCTION__))->decl_common.artificial_flag) = 1;
299 return label_decl;
300}
301
302
303/* Set the backend source location of a decl. */
304
305void
306gfc_set_decl_location (tree decl, locus * loc)
307{
308 DECL_SOURCE_LOCATION (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 308, __FUNCTION__))->decl_minimal.locus) = gfc_get_location (loc);
309}
310
311
312/* Return the backend label declaration for a given label structure,
313 or create it if it doesn't exist yet. */
314
315tree
316gfc_get_label_decl (gfc_st_label * lp)
317{
318 if (lp->backend_decl)
319 return lp->backend_decl;
320 else
321 {
322 char label_name[GFC_MAX_SYMBOL_LEN63 + 1];
323 tree label_decl;
324
325 /* Validate the label declaration from the front end. */
326 gcc_assert (lp != NULL && lp->value <= MAX_LABEL_VALUE)((void)(!(lp != __null && lp->value <= 99999) ?
fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 326, __FUNCTION__), 0 : 0));
327
328 /* Build a mangled name for the label. */
329 sprintf (label_name, "__label_%.6d", lp->value);
330
331 /* Build the LABEL_DECL node. */
332 label_decl = gfc_build_label_decl (get_identifier (label_name)(__builtin_constant_p (label_name) ? get_identifier_with_length
((label_name), strlen (label_name)) : get_identifier (label_name
)));
333
334 /* Tell the debugger where the label came from. */
335 if (lp->value <= MAX_LABEL_VALUE99999) /* An internal label. */
336 gfc_set_decl_location (label_decl, &lp->where);
337 else
338 DECL_ARTIFICIAL (label_decl)((contains_struct_check ((label_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 338, __FUNCTION__))->decl_common.artificial_flag) = 1;
339
340 /* Store the label in the label list and return the LABEL_DECL. */
341 lp->backend_decl = label_decl;
342 return label_decl;
343 }
344}
345
346/* Return the name of an identifier. */
347
348static const char *
349sym_identifier (gfc_symbol *sym)
350{
351 if (sym->attr.is_main_program && strcmp (sym->name, "main") == 0)
352 return "MAIN__";
353 else
354 return sym->name;
355}
356
357/* Convert a gfc_symbol to an identifier of the same name. */
358
359static tree
360gfc_sym_identifier (gfc_symbol * sym)
361{
362 return get_identifier (sym_identifier (sym))(__builtin_constant_p (sym_identifier (sym)) ? get_identifier_with_length
((sym_identifier (sym)), strlen (sym_identifier (sym))) : get_identifier
(sym_identifier (sym)));
363}
364
365/* Construct mangled name from symbol name. */
366
367static const char *
368mangled_identifier (gfc_symbol *sym)
369{
370 gfc_symbol *proc = sym->ns->proc_name;
371 static char name[3*GFC_MAX_MANGLED_SYMBOL_LEN(63*3+5) + 14];
372 /* Prevent the mangling of identifiers that have an assigned
373 binding label (mainly those that are bind(c)). */
374
375 if (sym->attr.is_bind_c == 1 && sym->binding_label)
376 return sym->binding_label;
377
378 if (!sym->fn_result_spec
379 || (sym->module && !(proc && proc->attr.flavor == FL_PROCEDURE)))
380 {
381 if (sym->module == NULL__null)
382 return sym_identifier (sym);
383 else
384 snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
385 }
386 else
387 {
388 /* This is an entity that is actually local to a module procedure
389 that appears in the result specification expression. Since
390 sym->module will be a zero length string, we use ns->proc_name
391 to provide the module name instead. */
392 if (proc && proc->module)
393 snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
394 proc->module, proc->name, sym->name);
395 else
396 snprintf (name, sizeof name, "__%s_PROC_%s",
397 proc->name, sym->name);
398 }
399
400 return name;
401}
402
403/* Get mangled identifier, adding the symbol to the global table if
404 it is not yet already there. */
405
406static tree
407gfc_sym_mangled_identifier (gfc_symbol * sym)
408{
409 tree result;
410 gfc_gsymbol *gsym;
411 const char *name;
412
413 name = mangled_identifier (sym);
414 result = get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name));
415
416 gsym = gfc_find_gsymbol (gfc_gsym_root, name);
417 if (gsym == NULL__null)
418 {
419 gsym = gfc_get_gsymbol (name, false);
420 gsym->ns = sym->ns;
421 gsym->sym_name = sym->name;
422 }
423
424 return result;
425}
426
427/* Construct mangled function name from symbol name. */
428
429static tree
430gfc_sym_mangled_function_id (gfc_symbol * sym)
431{
432 int has_underscore;
433 char name[GFC_MAX_MANGLED_SYMBOL_LEN(63*3+5) + 1];
434
435 /* It may be possible to simply use the binding label if it's
436 provided, and remove the other checks. Then we could use it
437 for other things if we wished. */
438 if ((sym->attr.is_bind_c == 1 || sym->attr.is_iso_c == 1) &&
439 sym->binding_label)
440 /* use the binding label rather than the mangled name */
441 return get_identifier (sym->binding_label)(__builtin_constant_p (sym->binding_label) ? get_identifier_with_length
((sym->binding_label), strlen (sym->binding_label)) : get_identifier
(sym->binding_label));
442
443 if ((sym->module == NULL__null || sym->attr.proc == PROC_EXTERNAL
444 || (sym->module != NULL__null && (sym->attr.external
445 || sym->attr.if_source == IFSRC_IFBODY)))
446 && !sym->attr.module_procedure)
447 {
448 /* Main program is mangled into MAIN__. */
449 if (sym->attr.is_main_program)
450 return get_identifier ("MAIN__")(__builtin_constant_p ("MAIN__") ? get_identifier_with_length
(("MAIN__"), strlen ("MAIN__")) : get_identifier ("MAIN__"));
451
452 /* Intrinsic procedures are never mangled. */
453 if (sym->attr.proc == PROC_INTRINSIC)
454 return get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name));
455
456 if (flag_underscoringglobal_options.x_flag_underscoring)
457 {
458 has_underscore = strchr (sym->name, '_') != 0;
459 if (flag_second_underscoreglobal_options.x_flag_second_underscore && has_underscore)
460 snprintf (name, sizeof name, "%s__", sym->name);
461 else
462 snprintf (name, sizeof name, "%s_", sym->name);
463 return get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name));
464 }
465 else
466 return get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name));
467 }
468 else
469 {
470 snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
471 return get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name));
472 }
473}
474
475
476void
477gfc_set_decl_assembler_name (tree decl, tree name)
478{
479 tree target_mangled = targetm.mangle_decl_assembler_name (decl, name);
480 SET_DECL_ASSEMBLER_NAME (decl, target_mangled)overwrite_decl_assembler_name (decl, target_mangled);
481}
482
483
484/* Returns true if a variable of specified size should go on the stack. */
485
486int
487gfc_can_put_var_on_stack (tree size)
488{
489 unsigned HOST_WIDE_INTlong low;
490
491 if (!INTEGER_CST_P (size)(((enum tree_code) (size)->base.code) == INTEGER_CST))
492 return 0;
493
494 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size < 0)
495 return 1;
496
497 if (!tree_fits_uhwi_p (size))
498 return 0;
499
500 low = TREE_INT_CST_LOW (size)((unsigned long) (*tree_int_cst_elt_check ((size), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 500, __FUNCTION__)));
501 if (low > (unsigned HOST_WIDE_INTlong) flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size)
502 return 0;
503
504/* TODO: Set a per-function stack size limit. */
505
506 return 1;
507}
508
509
510/* gfc_finish_cray_pointee sets DECL_VALUE_EXPR for a Cray pointee to
511 an expression involving its corresponding pointer. There are
512 2 cases; one for variable size arrays, and one for everything else,
513 because variable-sized arrays require one fewer level of
514 indirection. */
515
516static void
517gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
518{
519 tree ptr_decl = gfc_get_symbol_decl (sym->cp_pointer);
520 tree value;
521
522 /* Parameters need to be dereferenced. */
523 if (sym->cp_pointer->attr.dummy)
524 ptr_decl = build_fold_indirect_ref_loc (input_location,
525 ptr_decl);
526
527 /* Check to see if we're dealing with a variable-sized array. */
528 if (sym->attr.dimension
529 && TREE_CODE (TREE_TYPE (decl))((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 529, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE)
530 {
531 /* These decls will be dereferenced later, so we don't dereference
532 them here. */
533 value = convert (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 533, __FUNCTION__))->typed.type), ptr_decl);
534 }
535 else
536 {
537 ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 537, __FUNCTION__))->typed.type)),
538 ptr_decl);
539 value = build_fold_indirect_ref_loc (input_location,
540 ptr_decl);
541 }
542
543 SET_DECL_VALUE_EXPR (decl, value)(decl_value_expr_insert ((contains_struct_check ((decl), (TS_DECL_WRTL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 543, __FUNCTION__)), value));
544 DECL_HAS_VALUE_EXPR_P (decl)((tree_check3 ((decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 544, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL)))
->decl_common.decl_flag_2) = 1;
545 GFC_DECL_CRAY_POINTEE (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 545, __FUNCTION__))->decl_common.lang_flag_4) = 1;
546}
547
548
549/* Finish processing of a declaration without an initial value. */
550
551static void
552gfc_finish_decl (tree decl)
553{
554 gcc_assert (TREE_CODE (decl) == PARM_DECL((void)(!(((enum tree_code) (decl)->base.code) == PARM_DECL
|| ((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 555, __FUNCTION__))->decl_common.initial) == (tree) __null
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 555, __FUNCTION__), 0 : 0))
555 || DECL_INITIAL (decl) == NULL_TREE)((void)(!(((enum tree_code) (decl)->base.code) == PARM_DECL
|| ((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 555, __FUNCTION__))->decl_common.initial) == (tree) __null
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 555, __FUNCTION__), 0 : 0));
556
557 if (!VAR_P (decl)(((enum tree_code) (decl)->base.code) == VAR_DECL))
558 return;
559
560 if (DECL_SIZE (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 560, __FUNCTION__))->decl_common.size) == NULL_TREE(tree) __null
561 && TYPE_SIZE (TREE_TYPE (decl))((tree_class_check ((((contains_struct_check ((decl), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 561, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 561, __FUNCTION__))->type_common.size) != NULL_TREE(tree) __null)
562 layout_decl (decl, 0);
563
564 /* A few consistency checks. */
565 /* A static variable with an incomplete type is an error if it is
566 initialized. Also if it is not file scope. Otherwise, let it
567 through, but if it is not `extern' then it may cause an error
568 message later. */
569 /* An automatic variable with an incomplete type is an error. */
570
571 /* We should know the storage size. */
572 gcc_assert (DECL_SIZE (decl) != NULL_TREE((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 572, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__), 0 : 0))
573 || (TREE_STATIC (decl)((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 572, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__), 0 : 0))
574 ? (!DECL_INITIAL (decl) || !DECL_CONTEXT (decl))((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 572, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__), 0 : 0))
575 : DECL_EXTERNAL (decl)))((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 572, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 574, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 575, __FUNCTION__), 0 : 0));
576
577 /* The storage size should be constant. */
578 gcc_assert ((!DECL_EXTERNAL (decl) && !TREE_STATIC (decl))((void)(!((!((contains_struct_check ((decl), (TS_DECL_COMMON)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 578, __FUNCTION__))->decl_common.decl_flag_1) &&
!((decl)->base.static_flag)) || !((contains_struct_check (
(decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 579, __FUNCTION__))->decl_common.size) || ((enum tree_code
) (((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 580, __FUNCTION__))->decl_common.size))->base.code) ==
INTEGER_CST) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 580, __FUNCTION__), 0 : 0))
579 || !DECL_SIZE (decl)((void)(!((!((contains_struct_check ((decl), (TS_DECL_COMMON)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 578, __FUNCTION__))->decl_common.decl_flag_1) &&
!((decl)->base.static_flag)) || !((contains_struct_check (
(decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 579, __FUNCTION__))->decl_common.size) || ((enum tree_code
) (((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 580, __FUNCTION__))->decl_common.size))->base.code) ==
INTEGER_CST) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 580, __FUNCTION__), 0 : 0))
580 || TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)((void)(!((!((contains_struct_check ((decl), (TS_DECL_COMMON)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 578, __FUNCTION__))->decl_common.decl_flag_1) &&
!((decl)->base.static_flag)) || !((contains_struct_check (
(decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 579, __FUNCTION__))->decl_common.size) || ((enum tree_code
) (((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 580, __FUNCTION__))->decl_common.size))->base.code) ==
INTEGER_CST) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 580, __FUNCTION__), 0 : 0));
581}
582
583
584/* Handle setting of GFC_DECL_SCALAR* on DECL. */
585
586void
587gfc_finish_decl_attrs (tree decl, symbol_attribute *attr)
588{
589 if (!attr->dimension && !attr->codimension)
590 {
591 /* Handle scalar allocatable variables. */
592 if (attr->allocatable)
593 {
594 gfc_allocate_lang_decl (decl);
595 GFC_DECL_SCALAR_ALLOCATABLE (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 595, __FUNCTION__))->decl_common.lang_specific)->scalar_allocatable
) = 1;
596 }
597 /* Handle scalar pointer variables. */
598 if (attr->pointer)
599 {
600 gfc_allocate_lang_decl (decl);
601 GFC_DECL_SCALAR_POINTER (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 601, __FUNCTION__))->decl_common.lang_specific)->scalar_pointer
) = 1;
602 }
603 if (attr->target)
604 {
605 gfc_allocate_lang_decl (decl);
606 GFC_DECL_SCALAR_TARGET (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 606, __FUNCTION__))->decl_common.lang_specific)->scalar_target
) = 1;
607 }
608 }
609}
610
611
612/* Apply symbol attributes to a variable, and add it to the function scope. */
613
614static void
615gfc_finish_var_decl (tree decl, gfc_symbol * sym)
616{
617 tree new_type;
618
619 /* Set DECL_VALUE_EXPR for Cray Pointees. */
620 if (sym->attr.cray_pointee)
621 gfc_finish_cray_pointee (decl, sym);
622
623 /* TREE_ADDRESSABLE means the address of this variable is actually needed.
624 This is the equivalent of the TARGET variables.
625 We also need to set this if the variable is passed by reference in a
626 CALL statement. */
627 if (sym->attr.target)
628 TREE_ADDRESSABLE (decl)((decl)->base.addressable_flag) = 1;
629
630 /* If it wasn't used we wouldn't be getting it. */
631 TREE_USED (decl)((decl)->base.used_flag) = 1;
632
633 if (sym->attr.flavor == FL_PARAMETER
634 && (sym->attr.dimension || sym->ts.type == BT_DERIVED))
635 TREE_READONLY (decl)((non_type_check ((decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 635, __FUNCTION__))->base.readonly_flag) = 1;
636
637 /* Chain this decl to the pending declarations. Don't do pushdecl()
638 because this would add them to the current scope rather than the
639 function scope. */
640 if (current_function_decl != NULL_TREE(tree) __null)
641 {
642 if (sym->ns->proc_name
643 && (sym->ns->proc_name->backend_decl == current_function_decl
644 || sym->result == sym))
645 gfc_add_decl_to_function (decl);
646 else if (sym->ns->proc_name
647 && sym->ns->proc_name->attr.flavor == FL_LABEL)
648 /* This is a BLOCK construct. */
649 add_decl_as_local (decl);
650 else if (sym->ns->omp_affinity_iterators)
651 /* This is a block-local iterator. */
652 add_decl_as_local (decl);
653 else
654 gfc_add_decl_to_parent_function (decl);
655 }
656
657 if (sym->attr.cray_pointee)
658 return;
659
660 if(sym->attr.is_bind_c == 1 && sym->binding_label)
661 {
662 /* We need to put variables that are bind(c) into the common
663 segment of the object file, because this is what C would do.
664 gfortran would typically put them in either the BSS or
665 initialized data segments, and only mark them as common if
666 they were part of common blocks. However, if they are not put
667 into common space, then C cannot initialize global Fortran
668 variables that it interoperates with and the draft says that
669 either Fortran or C should be able to initialize it (but not
670 both, of course.) (J3/04-007, section 15.3). */
671 TREE_PUBLIC(decl)((decl)->base.public_flag) = 1;
672 DECL_COMMON(decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 672, __FUNCTION__))->decl_with_vis.common_flag) = 1;
673 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
674 {
675 DECL_VISIBILITY (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 675, __FUNCTION__))->decl_with_vis.visibility) = VISIBILITY_HIDDEN;
676 DECL_VISIBILITY_SPECIFIED (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 676, __FUNCTION__))->decl_with_vis.visibility_specified) = true;
677 }
678 }
679
680 /* If a variable is USE associated, it's always external. */
681 if (sym->attr.use_assoc || sym->attr.used_in_submodule)
682 {
683 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 683, __FUNCTION__))->decl_common.decl_flag_1) = 1;
684 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
685 }
686 else if (sym->fn_result_spec && !sym->ns->proc_name->module)
687 {
688
689 if (sym->ns->proc_name->attr.if_source != IFSRC_DECL)
690 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 690, __FUNCTION__))->decl_common.decl_flag_1) = 1;
691 else
692 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
693
694 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
695 }
696 else if (sym->module && !sym->attr.result && !sym->attr.dummy)
697 {
698 /* TODO: Don't set sym->module for result or dummy variables. */
699 gcc_assert (current_function_decl == NULL_TREE || sym->result == sym)((void)(!(current_function_decl == (tree) __null || sym->result
== sym) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 699, __FUNCTION__), 0 : 0));
700
701 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
702 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
703 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
704 {
705 DECL_VISIBILITY (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 705, __FUNCTION__))->decl_with_vis.visibility) = VISIBILITY_HIDDEN;
706 DECL_VISIBILITY_SPECIFIED (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 706, __FUNCTION__))->decl_with_vis.visibility_specified) = true;
707 }
708 }
709
710 /* Derived types are a bit peculiar because of the possibility of
711 a default initializer; this must be applied each time the variable
712 comes into scope it therefore need not be static. These variables
713 are SAVE_NONE but have an initializer. Otherwise explicitly
714 initialized variables are SAVE_IMPLICIT and explicitly saved are
715 SAVE_EXPLICIT. */
716 if (!sym->attr.use_assoc
717 && (sym->attr.save != SAVE_NONE || sym->attr.data
718 || (sym->value && sym->ns->proc_name->attr.is_main_program)
719 || (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
720 && sym->attr.codimension && !sym->attr.allocatable)))
721 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
722
723 /* If derived-type variables with DTIO procedures are not made static
724 some bits of code referencing them get optimized away.
725 TODO Understand why this is so and fix it. */
726 if (!sym->attr.use_assoc
727 && ((sym->ts.type == BT_DERIVED
728 && sym->ts.u.derived->attr.has_dtio_procs)
729 || (sym->ts.type == BT_CLASS
730 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived->attr.has_dtio_procs)))
731 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
732
733 /* Treat asynchronous variables the same as volatile, for now. */
734 if (sym->attr.volatile_ || sym->attr.asynchronous)
735 {
736 TREE_THIS_VOLATILE (decl)((decl)->base.volatile_flag) = 1;
737 TREE_SIDE_EFFECTS (decl)((non_type_check ((decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 737, __FUNCTION__))->base.side_effects_flag) = 1;
738 new_type = build_qualified_type (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 738, __FUNCTION__))->typed.type), TYPE_QUAL_VOLATILE);
739 TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 739, __FUNCTION__))->typed.type) = new_type;
740 }
741
742 /* Keep variables larger than max-stack-var-size off stack. */
743 if (!(sym->ns->proc_name && sym->ns->proc_name->attr.recursive)
744 && !sym->attr.automatic
745 && !sym->attr.associate_var
746 && sym->attr.save != SAVE_EXPLICIT
747 && sym->attr.save != SAVE_IMPLICIT
748 && INTEGER_CST_P (DECL_SIZE_UNIT (decl))(((enum tree_code) (((contains_struct_check ((decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 748, __FUNCTION__))->decl_common.size_unit))->base.code
) == INTEGER_CST)
749 && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 749, __FUNCTION__))->decl_common.size_unit))
750 /* Put variable length auto array pointers always into stack. */
751 && (TREE_CODE (TREE_TYPE (decl))((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 751, __FUNCTION__))->typed.type))->base.code) != POINTER_TYPE
752 || sym->attr.dimension == 0
753 || sym->as->type != AS_EXPLICIT
754 || sym->attr.pointer
755 || sym->attr.allocatable)
756 && !DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 756, __FUNCTION__))->decl_common.artificial_flag))
757 {
758 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size > 0
759 && !(sym->ns->proc_name
760 && sym->ns->proc_name->attr.is_main_program))
761 gfc_warning (OPT_Wsurprising,
762 "Array %qs at %L is larger than limit set by "
763 "%<-fmax-stack-var-size=%>, moved from stack to static "
764 "storage. This makes the procedure unsafe when called "
765 "recursively, or concurrently from multiple threads. "
766 "Consider increasing the %<-fmax-stack-var-size=%> "
767 "limit (or use %<-frecursive%>, which implies "
768 "unlimited %<-fmax-stack-var-size%>) - or change the "
769 "code to use an ALLOCATABLE array. If the variable is "
770 "never accessed concurrently, this warning can be "
771 "ignored, and the variable could also be declared with "
772 "the SAVE attribute.",
773 sym->name, &sym->declared_at);
774
775 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
776
777 /* Because the size of this variable isn't known until now, we may have
778 greedily added an initializer to this variable (in build_init_assign)
779 even though the max-stack-var-size indicates the variable should be
780 static. Therefore we rip out the automatic initializer here and
781 replace it with a static one. */
782 gfc_symtree *st = gfc_find_symtree (sym->ns->sym_root, sym->name);
783 gfc_code *prev = NULL__null;
784 gfc_code *code = sym->ns->code;
785 while (code && code->op == EXEC_INIT_ASSIGN)
786 {
787 /* Look for an initializer meant for this symbol. */
788 if (code->expr1->symtree == st)
789 {
790 if (prev)
791 prev->next = code->next;
792 else
793 sym->ns->code = code->next;
794
795 break;
796 }
797
798 prev = code;
799 code = code->next;
800 }
801 if (code && code->op == EXEC_INIT_ASSIGN)
802 {
803 /* Keep the init expression for a static initializer. */
804 sym->value = code->expr2;
805 /* Cleanup the defunct code object, without freeing the init expr. */
806 code->expr2 = NULL__null;
807 gfc_free_statement (code);
808 free (code);
809 }
810 }
811
812 /* Handle threadprivate variables. */
813 if (sym->attr.threadprivate
814 && (TREE_STATIC (decl)((decl)->base.static_flag) || DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 814, __FUNCTION__))->decl_common.decl_flag_1)))
815 set_decl_tls_model (decl, decl_default_tls_model (decl));
816
817 /* Mark weak variables. */
818 if (sym->attr.ext_attr & (1 << EXT_ATTR_WEAK))
819 declare_weak (decl);
820
821 gfc_finish_decl_attrs (decl, &sym->attr);
822}
823
824
825/* Allocate the lang-specific part of a decl. */
826
827void
828gfc_allocate_lang_decl (tree decl)
829{
830 if (DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 830, __FUNCTION__))->decl_common.lang_specific) == NULL__null)
831 DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 831, __FUNCTION__))->decl_common.lang_specific) = ggc_cleared_alloc<struct lang_decl> ();
832}
833
834/* Remember a symbol to generate initialization/cleanup code at function
835 entry/exit. */
836
837static void
838gfc_defer_symbol_init (gfc_symbol * sym)
839{
840 gfc_symbol *p;
841 gfc_symbol *last;
842 gfc_symbol *head;
843
844 /* Don't add a symbol twice. */
845 if (sym->tlink)
846 return;
847
848 last = head = sym->ns->proc_name;
849 p = last->tlink;
850
851 /* Make sure that setup code for dummy variables which are used in the
852 setup of other variables is generated first. */
853 if (sym->attr.dummy)
854 {
855 /* Find the first dummy arg seen after us, or the first non-dummy arg.
856 This is a circular list, so don't go past the head. */
857 while (p != head
858 && (!p->attr.dummy || p->dummy_order > sym->dummy_order))
859 {
860 last = p;
861 p = p->tlink;
862 }
863 }
864 /* Insert in between last and p. */
865 last->tlink = sym;
866 sym->tlink = p;
867}
868
869
870/* Used in gfc_get_symbol_decl and gfc_get_derived_type to obtain the
871 backend_decl for a module symbol, if it all ready exists. If the
872 module gsymbol does not exist, it is created. If the symbol does
873 not exist, it is added to the gsymbol namespace. Returns true if
874 an existing backend_decl is found. */
875
876bool
877gfc_get_module_backend_decl (gfc_symbol *sym)
878{
879 gfc_gsymbol *gsym;
880 gfc_symbol *s;
881 gfc_symtree *st;
882
883 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module);
884
885 if (!gsym || (gsym->ns && gsym->type == GSYM_MODULE))
886 {
887 st = NULL__null;
888 s = NULL__null;
889
890 /* Check for a symbol with the same name. */
891 if (gsym)
892 gfc_find_symbol (sym->name, gsym->ns, 0, &s);
893
894 if (!s)
895 {
896 if (!gsym)
897 {
898 gsym = gfc_get_gsymbol (sym->module, false);
899 gsym->type = GSYM_MODULE;
900 gsym->ns = gfc_get_namespace (NULL__null, 0);
901 }
902
903 st = gfc_new_symtree (&gsym->ns->sym_root, sym->name);
904 st->n.sym = sym;
905 sym->refs++;
906 }
907 else if (gfc_fl_struct (sym->attr.flavor)((sym->attr.flavor) == FL_DERIVED || (sym->attr.flavor)
== FL_UNION || (sym->attr.flavor) == FL_STRUCT))
908 {
909 if (s && s->attr.flavor == FL_PROCEDURE)
910 {
911 gfc_interface *intr;
912 gcc_assert (s->attr.generic)((void)(!(s->attr.generic) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 912, __FUNCTION__), 0 : 0));
913 for (intr = s->generic; intr; intr = intr->next)
914 if (gfc_fl_struct (intr->sym->attr.flavor)((intr->sym->attr.flavor) == FL_DERIVED || (intr->sym
->attr.flavor) == FL_UNION || (intr->sym->attr.flavor
) == FL_STRUCT))
915 {
916 s = intr->sym;
917 break;
918 }
919 }
920
921 /* Normally we can assume that s is a derived-type symbol since it
922 shares a name with the derived-type sym. However if sym is a
923 STRUCTURE, it may in fact share a name with any other basic type
924 variable. If s is in fact of derived type then we can continue
925 looking for a duplicate type declaration. */
926 if (sym->attr.flavor == FL_STRUCT && s->ts.type == BT_DERIVED)
927 {
928 s = s->ts.u.derived;
929 }
930
931 if (gfc_fl_struct (s->attr.flavor)((s->attr.flavor) == FL_DERIVED || (s->attr.flavor) == FL_UNION
|| (s->attr.flavor) == FL_STRUCT) && !s->backend_decl)
932 {
933 if (s->attr.flavor == FL_UNION)
934 s->backend_decl = gfc_get_union_type (s);
935 else
936 s->backend_decl = gfc_get_derived_type (s);
937 }
938 gfc_copy_dt_decls_ifequal (s, sym, true);
939 return true;
940 }
941 else if (s->backend_decl)
942 {
943 if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
944 gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived,
945 true);
946 else if (sym->ts.type == BT_CHARACTER)
947 sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;
948 sym->backend_decl = s->backend_decl;
949 return true;
950 }
951 }
952 return false;
953}
954
955
956/* Create an array index type variable with function scope. */
957
958static tree
959create_index_var (const char * pfx, int nest)
960{
961 tree decl;
962
963 decl = gfc_create_var_np (gfc_array_index_type, pfx);
964 if (nest)
965 gfc_add_decl_to_parent_function (decl);
966 else
967 gfc_add_decl_to_function (decl);
968 return decl;
969}
970
971
972/* Create variables to hold all the non-constant bits of info for a
973 descriptorless array. Remember these in the lang-specific part of the
974 type. */
975
976static void
977gfc_build_qualified_array (tree decl, gfc_symbol * sym)
978{
979 tree type;
980 int dim;
981 int nest;
982 gfc_namespace* procns;
983 symbol_attribute *array_attr;
984 gfc_array_spec *as;
985 bool is_classarray = IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer);
986
987 type = TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 987, __FUNCTION__))->typed.type);
988 array_attr = is_classarray ? &CLASS_DATA (sym)sym->ts.u.derived->components->attr : &sym->attr;
989 as = is_classarray ? CLASS_DATA (sym)sym->ts.u.derived->components->as : sym->as;
990
991 /* We just use the descriptor, if there is one. */
992 if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 992, __FUNCTION__))->type_common.lang_flag_1))
993 return;
994
995 gcc_assert (GFC_ARRAY_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 995, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 995, __FUNCTION__), 0 : 0));
996 procns = gfc_find_proc_namespace (sym->ns);
997 nest = (procns->proc_name->backend_decl != current_function_decl)
998 && !sym->attr.contained;
999
1000 if (array_attr->codimension && flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
1001 && as->type != AS_ASSUMED_SHAPE
1002 && GFC_TYPE_ARRAY_CAF_TOKEN (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1002, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token) == NULL_TREE(tree) __null)
1003 {
1004 tree token;
1005 tree token_type = build_qualified_type (pvoid_type_node,
1006 TYPE_QUAL_RESTRICT);
1007
1008 if (sym->module && (sym->attr.use_assoc
1009 || sym->ns->proc_name->attr.flavor == FL_MODULE))
1010 {
1011 tree token_name
1012 = get_identifier (gfc_get_string (GFC_PREFIX ("caf_token%s"),(__builtin_constant_p (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))) ? get_identifier_with_length ((gfc_get_string ("_F." "caf_token%s"
, ((const char *) (tree_check ((gfc_sym_mangled_identifier (sym
)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))), strlen (gfc_get_string ("_F." "caf_token%s", ((const char
*) (tree_check ((gfc_sym_mangled_identifier (sym)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)))) : get_identifier (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))))
1013 IDENTIFIER_POINTER (gfc_sym_mangled_identifier (sym))))(__builtin_constant_p (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))) ? get_identifier_with_length ((gfc_get_string ("_F." "caf_token%s"
, ((const char *) (tree_check ((gfc_sym_mangled_identifier (sym
)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))), strlen (gfc_get_string ("_F." "caf_token%s", ((const char
*) (tree_check ((gfc_sym_mangled_identifier (sym)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)))) : get_identifier (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1013, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))));
1014 token = build_decl (DECL_SOURCE_LOCATION (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1014, __FUNCTION__))->decl_minimal.locus), VAR_DECL, token_name,
1015 token_type);
1016 if (sym->attr.use_assoc)
1017 DECL_EXTERNAL (token)((contains_struct_check ((token), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1017, __FUNCTION__))->decl_common.decl_flag_1) = 1;
1018 else
1019 TREE_STATIC (token)((token)->base.static_flag) = 1;
1020
1021 TREE_PUBLIC (token)((token)->base.public_flag) = 1;
1022
1023 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
1024 {
1025 DECL_VISIBILITY (token)((contains_struct_check ((token), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1025, __FUNCTION__))->decl_with_vis.visibility) = VISIBILITY_HIDDEN;
1026 DECL_VISIBILITY_SPECIFIED (token)((contains_struct_check ((token), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1026, __FUNCTION__))->decl_with_vis.visibility_specified
) = true;
1027 }
1028 }
1029 else
1030 {
1031 token = gfc_create_var_np (token_type, "caf_token");
1032 TREE_STATIC (token)((token)->base.static_flag) = 1;
1033 }
1034
1035 GFC_TYPE_ARRAY_CAF_TOKEN (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1035, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token) = token;
1036 DECL_ARTIFICIAL (token)((contains_struct_check ((token), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1036, __FUNCTION__))->decl_common.artificial_flag) = 1;
1037 DECL_NONALIASED (token)((tree_check ((token), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1037, __FUNCTION__, (VAR_DECL)))->base.nothrow_flag) = 1;
1038
1039 if (sym->module && !sym->attr.use_assoc)
1040 {
1041 pushdecl (token);
1042 DECL_CONTEXT (token)((contains_struct_check ((token), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1042, __FUNCTION__))->decl_minimal.context) = sym->ns->proc_name->backend_decl;
1043 gfc_module_add_decl (cur_module, token);
1044 }
1045 else if (sym->attr.host_assoc
1046 && TREE_CODE (DECL_CONTEXT (current_function_decl))((enum tree_code) (((contains_struct_check ((current_function_decl
), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1046, __FUNCTION__))->decl_minimal.context))->base.code
)
1047 != TRANSLATION_UNIT_DECL)
1048 gfc_add_decl_to_parent_function (token);
1049 else
1050 gfc_add_decl_to_function (token);
1051 }
1052
1053 for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1053, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank); dim++)
1054 {
1055 if (GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1055, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]) == NULL_TREE(tree) __null)
1056 {
1057 GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1057, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]) = create_index_var ("lbound", nest);
1058 suppress_warning (GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1058, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]));
1059 }
1060 /* Don't try to use the unknown bound for assumed shape arrays. */
1061 if (GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1061, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]) == NULL_TREE(tree) __null
1062 && (as->type != AS_ASSUMED_SIZE
1063 || dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1063, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank) - 1))
1064 {
1065 GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1065, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]) = create_index_var ("ubound", nest);
1066 suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1066, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]));
1067 }
1068
1069 if (GFC_TYPE_ARRAY_STRIDE (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1069, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[dim]) == NULL_TREE(tree) __null)
1070 {
1071 GFC_TYPE_ARRAY_STRIDE (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1071, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[dim]) = create_index_var ("stride", nest);
1072 suppress_warning (GFC_TYPE_ARRAY_STRIDE (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1072, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[dim]));
1073 }
1074 }
1075 for (dim = GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1075, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank);
1076 dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1076, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank) + GFC_TYPE_ARRAY_CORANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1076, __FUNCTION__))->type_with_lang_specific.lang_specific
)->corank); dim++)
1077 {
1078 if (GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1078, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]) == NULL_TREE(tree) __null)
1079 {
1080 GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1080, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]) = create_index_var ("lbound", nest);
1081 suppress_warning (GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1081, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]));
1082 }
1083 /* Don't try to use the unknown ubound for the last coarray dimension. */
1084 if (GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1084, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]) == NULL_TREE(tree) __null
1085 && dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1085, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank) + GFC_TYPE_ARRAY_CORANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1085, __FUNCTION__))->type_with_lang_specific.lang_specific
)->corank) - 1)
1086 {
1087 GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1087, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]) = create_index_var ("ubound", nest);
1088 suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1088, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]));
1089 }
1090 }
1091 if (GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1091, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset) == NULL_TREE(tree) __null)
1092 {
1093 GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1093, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset) = gfc_create_var_np (gfc_array_index_type,
1094 "offset");
1095 suppress_warning (GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1095, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset));
1096
1097 if (nest)
1098 gfc_add_decl_to_parent_function (GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1098, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset));
1099 else
1100 gfc_add_decl_to_function (GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1100, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset));
1101 }
1102
1103 if (GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1103, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size) == NULL_TREE(tree) __null
1104 && as->type != AS_ASSUMED_SIZE)
1105 {
1106 GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1106, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size) = create_index_var ("size", nest);
1107 suppress_warning (GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1107, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size));
1108 }
1109
1110 if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE))
1111 {
1112 gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (type)))((void)(!(((tree_class_check ((((contains_struct_check ((type
), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1112, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1112, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1112, __FUNCTION__), 0 : 0));
1113 gcc_assert (TYPE_LANG_SPECIFIC (type)((void)(!(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1113, __FUNCTION__))->type_with_lang_specific.lang_specific
) == ((tree_class_check ((((contains_struct_check ((type), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1114, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1114, __FUNCTION__))->type_with_lang_specific.lang_specific
)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1114, __FUNCTION__), 0 : 0))
1114 == TYPE_LANG_SPECIFIC (TREE_TYPE (type)))((void)(!(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1113, __FUNCTION__))->type_with_lang_specific.lang_specific
) == ((tree_class_check ((((contains_struct_check ((type), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1114, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1114, __FUNCTION__))->type_with_lang_specific.lang_specific
)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1114, __FUNCTION__), 0 : 0));
1115 type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1115, __FUNCTION__))->typed.type);
1116 }
1117
1118 if (! COMPLETE_TYPE_P (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1118, __FUNCTION__))->type_common.size) != (tree) __null
) && GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1118, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size))
1119 {
1120 tree size, range;
1121
1122 size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
1123 GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1123, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size), gfc_index_one_nodegfc_rank_cst[1]);
1124 range = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
1125 size);
1126 TYPE_DOMAIN (type)((tree_check ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1126, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
) = range;
1127 layout_type (type);
1128 }
1129
1130 if (TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1130, __FUNCTION__))->type_common.name) != NULL_TREE(tree) __null && as->rank > 0
1131 && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1131, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[as->rank - 1]) != NULL_TREE(tree) __null
1132 && VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1))(((enum tree_code) ((((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1132, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[as->rank - 1]))->base.code) == VAR_DECL))
1133 {
1134 tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type))((tree_check ((((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1134, __FUNCTION__))->type_common.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1134, __FUNCTION__, (TYPE_DECL)))->decl_non_common.result
);
1135
1136 for (dim = 0; dim < as->rank - 1; dim++)
1137 {
1138 gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE)((void)(!(((enum tree_code) (gtype)->base.code) == ARRAY_TYPE
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1138, __FUNCTION__), 0 : 0));
1139 gtype = TREE_TYPE (gtype)((contains_struct_check ((gtype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1139, __FUNCTION__))->typed.type);
1140 }
1141 gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE)((void)(!(((enum tree_code) (gtype)->base.code) == ARRAY_TYPE
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1141, __FUNCTION__), 0 : 0));
1142 if (TYPE_MAX_VALUE (TYPE_DOMAIN (gtype))((tree_check5 ((((tree_check ((gtype), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1142, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1142, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
) == NULL__null)
1143 TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1143, __FUNCTION__))->type_common.name) = NULL_TREE(tree) __null;
1144 }
1145
1146 if (TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1146, __FUNCTION__))->type_common.name) == NULL_TREE(tree) __null)
1147 {
1148 tree gtype = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1148, __FUNCTION__))->typed.type), rtype, type_decl;
1149
1150 for (dim = as->rank - 1; dim >= 0; dim--)
1151 {
1152 tree lbound, ubound;
1153 lbound = GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1153, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]);
1154 ubound = GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1154, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]);
1155 rtype = build_range_type (gfc_array_index_type, lbound, ubound);
1156 gtype = build_array_type (gtype, rtype);
1157 /* Ensure the bound variables aren't optimized out at -O0.
1158 For -O1 and above they often will be optimized out, but
1159 can be tracked by VTA. Also set DECL_NAMELESS, so that
1160 the artificial lbound.N or ubound.N DECL_NAME doesn't
1161 end up in debug info. */
1162 if (lbound
1163 && VAR_P (lbound)(((enum tree_code) (lbound)->base.code) == VAR_DECL)
1164 && DECL_ARTIFICIAL (lbound)((contains_struct_check ((lbound), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1164, __FUNCTION__))->decl_common.artificial_flag)
1165 && DECL_IGNORED_P (lbound)((contains_struct_check ((lbound), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1165, __FUNCTION__))->decl_common.ignored_flag))
1166 {
1167 if (DECL_NAME (lbound)((contains_struct_check ((lbound), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1167, __FUNCTION__))->decl_minimal.name)
1168 && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound))((const char *) (tree_check ((((contains_struct_check ((lbound
), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1168, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1168, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
),
1169 "lbound") != 0)
1170 DECL_NAMELESS (lbound)((contains_struct_check ((lbound), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1170, __FUNCTION__))->base.u.bits.nameless_flag) = 1;
1171 DECL_IGNORED_P (lbound)((contains_struct_check ((lbound), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1171, __FUNCTION__))->decl_common.ignored_flag) = 0;
1172 }
1173 if (ubound
1174 && VAR_P (ubound)(((enum tree_code) (ubound)->base.code) == VAR_DECL)
1175 && DECL_ARTIFICIAL (ubound)((contains_struct_check ((ubound), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1175, __FUNCTION__))->decl_common.artificial_flag)
1176 && DECL_IGNORED_P (ubound)((contains_struct_check ((ubound), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1176, __FUNCTION__))->decl_common.ignored_flag))
1177 {
1178 if (DECL_NAME (ubound)((contains_struct_check ((ubound), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1178, __FUNCTION__))->decl_minimal.name)
1179 && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound))((const char *) (tree_check ((((contains_struct_check ((ubound
), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1179, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1179, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
),
1180 "ubound") != 0)
1181 DECL_NAMELESS (ubound)((contains_struct_check ((ubound), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1181, __FUNCTION__))->base.u.bits.nameless_flag) = 1;
1182 DECL_IGNORED_P (ubound)((contains_struct_check ((ubound), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1182, __FUNCTION__))->decl_common.ignored_flag) = 0;
1183 }
1184 }
1185 TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1185, __FUNCTION__))->type_common.name) = type_decl = build_decl (input_location,
1186 TYPE_DECL, NULL__null, gtype);
1187 DECL_ORIGINAL_TYPE (type_decl)((tree_check ((type_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1187, __FUNCTION__, (TYPE_DECL)))->decl_non_common.result
) = gtype;
1188 }
1189}
1190
1191
1192/* For some dummy arguments we don't use the actual argument directly.
1193 Instead we create a local decl and use that. This allows us to perform
1194 initialization, and construct full type information. */
1195
1196static tree
1197gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
1198{
1199 tree decl;
1200 tree type;
1201 gfc_array_spec *as;
1202 symbol_attribute *array_attr;
1203 char *name;
1204 gfc_packed packed;
1205 int n;
1206 bool known_size;
1207 bool is_classarray = IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer);
1208
1209 /* Use the array as and attr. */
1210 as = is_classarray ? CLASS_DATA (sym)sym->ts.u.derived->components->as : sym->as;
1211 array_attr = is_classarray ? &CLASS_DATA (sym)sym->ts.u.derived->components->attr : &sym->attr;
1212
1213 /* The dummy is returned for pointer, allocatable or assumed rank arrays.
1214 For class arrays the information if sym is an allocatable or pointer
1215 object needs to be checked explicitly (IS_CLASS_ARRAY can be false for
1216 too many reasons to be of use here). */
1217 if ((sym->ts.type != BT_CLASS && sym->attr.pointer)
1218 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer)
1219 || array_attr->allocatable
1220 || (as && as->type == AS_ASSUMED_RANK))
1221 return dummy;
1222
1223 /* Add to list of variables if not a fake result variable.
1224 These symbols are set on the symbol only, not on the class component. */
1225 if (sym->attr.result || sym->attr.dummy)
1226 gfc_defer_symbol_init (sym);
1227
1228 /* For a class array the array descriptor is in the _data component, while
1229 for a regular array the TREE_TYPE of the dummy is a pointer to the
1230 descriptor. */
1231 type = TREE_TYPE (is_classarray ? gfc_class_data_get (dummy)((contains_struct_check ((is_classarray ? gfc_class_data_get (
dummy) : ((contains_struct_check ((dummy), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1232, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1232, __FUNCTION__))->typed.type)
1232 : TREE_TYPE (dummy))((contains_struct_check ((is_classarray ? gfc_class_data_get (
dummy) : ((contains_struct_check ((dummy), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1232, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1232, __FUNCTION__))->typed.type);
1233 /* type now is the array descriptor w/o any indirection. */
1234 gcc_assert (TREE_CODE (dummy) == PARM_DECL((void)(!(((enum tree_code) (dummy)->base.code) == PARM_DECL
&& (((enum tree_code) (((contains_struct_check ((dummy
), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1235, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((dummy), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1235, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1235, __FUNCTION__), 0 : 0))
1235 && POINTER_TYPE_P (TREE_TYPE (dummy)))((void)(!(((enum tree_code) (dummy)->base.code) == PARM_DECL
&& (((enum tree_code) (((contains_struct_check ((dummy
), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1235, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((dummy), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1235, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1235, __FUNCTION__), 0 : 0));
1236
1237 /* Do we know the element size? */
1238 known_size = sym->ts.type != BT_CHARACTER
1239 || INTEGER_CST_P (sym->ts.u.cl->backend_decl)(((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == INTEGER_CST);
1240
1241 if (known_size && !GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1241, __FUNCTION__))->type_common.lang_flag_1))
1242 {
1243 /* For descriptorless arrays with known element size the actual
1244 argument is sufficient. */
1245 gfc_build_qualified_array (dummy, sym);
1246 return dummy;
1247 }
1248
1249 if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1249, __FUNCTION__))->type_common.lang_flag_1))
1250 {
1251 /* Create a descriptorless array pointer. */
1252 packed = PACKED_NO;
1253
1254 /* Even when -frepack-arrays is used, symbols with TARGET attribute
1255 are not repacked. */
1256 if (!flag_repack_arraysglobal_options.x_flag_repack_arrays || sym->attr.target)
1257 {
1258 if (as->type == AS_ASSUMED_SIZE)
1259 packed = PACKED_FULL;
1260 }
1261 else
1262 {
1263 if (as->type == AS_EXPLICIT)
1264 {
1265 packed = PACKED_FULL;
1266 for (n = 0; n < as->rank; n++)
1267 {
1268 if (!(as->upper[n]
1269 && as->lower[n]
1270 && as->upper[n]->expr_type == EXPR_CONSTANT
1271 && as->lower[n]->expr_type == EXPR_CONSTANT))
1272 {
1273 packed = PACKED_PARTIAL;
1274 break;
1275 }
1276 }
1277 }
1278 else
1279 packed = PACKED_PARTIAL;
1280 }
1281
1282 /* For classarrays the element type is required, but
1283 gfc_typenode_for_spec () returns the array descriptor. */
1284 type = is_classarray ? gfc_get_element_type (type)
1285 : gfc_typenode_for_spec (&sym->ts);
1286 type = gfc_get_nodesc_array_type (type, as, packed,
1287 !sym->attr.target);
1288 }
1289 else
1290 {
1291 /* We now have an expression for the element size, so create a fully
1292 qualified type. Reset sym->backend decl or this will just return the
1293 old type. */
1294 DECL_ARTIFICIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1294, __FUNCTION__))->decl_common.artificial_flag) = 1;
1295 sym->backend_decl = NULL_TREE(tree) __null;
1296 type = gfc_sym_type (sym);
1297 packed = PACKED_FULL;
1298 }
1299
1300 ASM_FORMAT_PRIVATE_NAME (name, IDENTIFIER_POINTER (DECL_NAME (dummy)), 0)do { const char *const name_ = (((const char *) (tree_check (
(((contains_struct_check ((dummy), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1300, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1300, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)); char *const output_ = (name) = (char *) __builtin_alloca(
strlen (name_) + 32); sprintf (output_, "%s.%lu", name_, (unsigned
long)(0)); } while (0);
1301 decl = build_decl (input_location,
1302 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)), type);
1303
1304 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1304, __FUNCTION__))->decl_common.artificial_flag) = 1;
1305 DECL_NAMELESS (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1305, __FUNCTION__))->base.u.bits.nameless_flag) = 1;
1306 TREE_PUBLIC (decl)((decl)->base.public_flag) = 0;
1307 TREE_STATIC (decl)((decl)->base.static_flag) = 0;
1308 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1308, __FUNCTION__))->decl_common.decl_flag_1) = 0;
1309
1310 /* Avoid uninitialized warnings for optional dummy arguments. */
1311 if ((sym->ts.type == BT_CLASS && CLASS_DATA (sym)sym->ts.u.derived->components->attr.optional)
1312 || sym->attr.optional)
1313 suppress_warning (decl);
1314
1315 /* We should never get deferred shape arrays here. We used to because of
1316 frontend bugs. */
1317 gcc_assert (as->type != AS_DEFERRED)((void)(!(as->type != AS_DEFERRED) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1317, __FUNCTION__), 0 : 0));
1318
1319 if (packed == PACKED_PARTIAL)
1320 GFC_DECL_PARTIAL_PACKED_ARRAY (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1320, __FUNCTION__))->decl_common.lang_flag_1) = 1;
1321 else if (packed == PACKED_FULL)
1322 GFC_DECL_PACKED_ARRAY (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1322, __FUNCTION__))->decl_common.lang_flag_0) = 1;
1323
1324 gfc_build_qualified_array (decl, sym);
1325
1326 if (DECL_LANG_SPECIFIC (dummy)((contains_struct_check ((dummy), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1326, __FUNCTION__))->decl_common.lang_specific))
1327 DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1327, __FUNCTION__))->decl_common.lang_specific) = DECL_LANG_SPECIFIC (dummy)((contains_struct_check ((dummy), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1327, __FUNCTION__))->decl_common.lang_specific);
1328 else
1329 gfc_allocate_lang_decl (decl);
1330
1331 GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1331, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
) = dummy;
1332
1333 if (sym->ns->proc_name->backend_decl == current_function_decl
1334 || sym->attr.contained)
1335 gfc_add_decl_to_function (decl);
1336 else
1337 gfc_add_decl_to_parent_function (decl);
1338
1339 return decl;
1340}
1341
1342/* Return a constant or a variable to use as a string length. Does not
1343 add the decl to the current scope. */
1344
1345static tree
1346gfc_create_string_length (gfc_symbol * sym)
1347{
1348 gcc_assert (sym->ts.u.cl)((void)(!(sym->ts.u.cl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1348, __FUNCTION__), 0 : 0));
1349 gfc_conv_const_charlen (sym->ts.u.cl);
1350
1351 if (sym->ts.u.cl->backend_decl == NULL_TREE(tree) __null)
1352 {
1353 tree length;
1354 const char *name;
1355
1356 /* The string length variable shall be in static memory if it is either
1357 explicitly SAVED, a module variable or with -fno-automatic. Only
1358 relevant is "len=:" - otherwise, it is either a constant length or
1359 it is an automatic variable. */
1360 bool static_length = sym->attr.save
1361 || sym->ns->proc_name->attr.flavor == FL_MODULE
1362 || (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == 0
1363 && sym->ts.deferred && !sym->attr.dummy
1364 && !sym->attr.result && !sym->attr.function);
1365
1366 /* Also prefix the mangled name. We need to call GFC_PREFIX for static
1367 variables as some systems do not support the "." in the assembler name.
1368 For nonstatic variables, the "." does not appear in assembler. */
1369 if (static_length)
1370 {
1371 if (sym->module)
1372 name = gfc_get_string (GFC_PREFIX ("%s_MOD_%s")"_F." "%s_MOD_%s", sym->module,
1373 sym->name);
1374 else
1375 name = gfc_get_string (GFC_PREFIX ("%s")"_F." "%s", sym->name);
1376 }
1377 else if (sym->module)
1378 name = gfc_get_string (".__%s_MOD_%s", sym->module, sym->name);
1379 else
1380 name = gfc_get_string (".%s", sym->name);
1381
1382 length = build_decl (input_location,
1383 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)),
1384 gfc_charlen_type_node);
1385 DECL_ARTIFICIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1385, __FUNCTION__))->decl_common.artificial_flag) = 1;
1386 TREE_USED (length)((length)->base.used_flag) = 1;
1387 if (sym->ns->proc_name->tlink != NULL__null)
1388 gfc_defer_symbol_init (sym);
1389
1390 sym->ts.u.cl->backend_decl = length;
1391
1392 if (static_length)
1393 TREE_STATIC (length)((length)->base.static_flag) = 1;
1394
1395 if (sym->ns->proc_name->attr.flavor == FL_MODULE
1396 && (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used))
1397 TREE_PUBLIC (length)((length)->base.public_flag) = 1;
1398 }
1399
1400 gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE)((void)(!(sym->ts.u.cl->backend_decl != (tree) __null) ?
fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1400, __FUNCTION__), 0 : 0));
1401 return sym->ts.u.cl->backend_decl;
1402}
1403
1404/* If a variable is assigned a label, we add another two auxiliary
1405 variables. */
1406
1407static void
1408gfc_add_assign_aux_vars (gfc_symbol * sym)
1409{
1410 tree addr;
1411 tree length;
1412 tree decl;
1413
1414 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1414, __FUNCTION__), 0 : 0));
1415
1416 decl = sym->backend_decl;
1417 gfc_allocate_lang_decl (decl);
1418 GFC_DECL_ASSIGN (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1418, __FUNCTION__))->decl_common.lang_flag_2) = 1;
1419 length = build_decl (input_location,
1420 VAR_DECL, create_tmp_var_name (sym->name),
1421 gfc_charlen_type_node);
1422 addr = build_decl (input_location,
1423 VAR_DECL, create_tmp_var_name (sym->name),
1424 pvoid_type_node);
1425 gfc_finish_var_decl (length, sym);
1426 gfc_finish_var_decl (addr, sym);
1427 /* STRING_LENGTH is also used as flag. Less than -1 means that
1428 ASSIGN_ADDR cannot be used. Equal -1 means that ASSIGN_ADDR is the
1429 target label's address. Otherwise, value is the length of a format string
1430 and ASSIGN_ADDR is its address. */
1431 if (TREE_STATIC (length)((length)->base.static_flag))
1432 DECL_INITIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1432, __FUNCTION__))->decl_common.initial) = build_int_cst (gfc_charlen_type_node, -2);
1433 else
1434 gfc_defer_symbol_init (sym);
1435
1436 GFC_DECL_STRING_LEN (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1436, __FUNCTION__))->decl_common.lang_specific)->stringlen = length;
1437 GFC_DECL_ASSIGN_ADDR (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1437, __FUNCTION__))->decl_common.lang_specific)->addr = addr;
1438}
1439
1440
1441static tree
1442add_attributes_to_decl (symbol_attribute sym_attr, tree list)
1443{
1444 unsigned id;
1445 tree attr;
1446
1447 for (id = 0; id < EXT_ATTR_NUM; id++)
1448 if (sym_attr.ext_attr & (1 << id) && ext_attr_list[id].middle_end_name)
1449 {
1450 attr = build_tree_list (
1451 get_identifier (ext_attr_list[id].middle_end_name)(__builtin_constant_p (ext_attr_list[id].middle_end_name) ? get_identifier_with_length
((ext_attr_list[id].middle_end_name), strlen (ext_attr_list[
id].middle_end_name)) : get_identifier (ext_attr_list[id].middle_end_name
)),
1452 NULL_TREE(tree) __null);
1453 list = chainon (list, attr);
1454 }
1455
1456 tree clauses = NULL_TREE(tree) __null;
1457
1458 if (sym_attr.oacc_routine_lop != OACC_ROUTINE_LOP_NONE)
1459 {
1460 omp_clause_code code;
1461 switch (sym_attr.oacc_routine_lop)
1462 {
1463 case OACC_ROUTINE_LOP_GANG:
1464 code = OMP_CLAUSE_GANG;
1465 break;
1466 case OACC_ROUTINE_LOP_WORKER:
1467 code = OMP_CLAUSE_WORKER;
1468 break;
1469 case OACC_ROUTINE_LOP_VECTOR:
1470 code = OMP_CLAUSE_VECTOR;
1471 break;
1472 case OACC_ROUTINE_LOP_SEQ:
1473 code = OMP_CLAUSE_SEQ;
1474 break;
1475 case OACC_ROUTINE_LOP_NONE:
1476 case OACC_ROUTINE_LOP_ERROR:
1477 default:
1478 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1478, __FUNCTION__));
1479 }
1480 tree c = build_omp_clause (UNKNOWN_LOCATION((location_t) 0), code);
1481 OMP_CLAUSE_CHAIN (c)((contains_struct_check (((tree_check ((c), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1481, __FUNCTION__, (OMP_CLAUSE)))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1481, __FUNCTION__))->common.chain) = clauses;
1482 clauses = c;
1483
1484 tree dims = oacc_build_routine_dims (clauses);
1485 list = oacc_replace_fn_attrib_attr (list, dims);
1486 }
1487
1488 if (sym_attr.oacc_routine_nohost)
1489 {
1490 tree c = build_omp_clause (UNKNOWN_LOCATION((location_t) 0), OMP_CLAUSE_NOHOST);
1491 OMP_CLAUSE_CHAIN (c)((contains_struct_check (((tree_check ((c), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1491, __FUNCTION__, (OMP_CLAUSE)))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1491, __FUNCTION__))->common.chain) = clauses;
1492 clauses = c;
1493 }
1494
1495 if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET)
1496 {
1497 tree c = build_omp_clause (UNKNOWN_LOCATION((location_t) 0), OMP_CLAUSE_DEVICE_TYPE);
1498 switch (sym_attr.omp_device_type)
1499 {
1500 case OMP_DEVICE_TYPE_HOST:
1501 OMP_CLAUSE_DEVICE_TYPE_KIND (c)((omp_clause_subcode_check ((c), (OMP_CLAUSE_DEVICE_TYPE), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1501, __FUNCTION__))->omp_clause.subcode.device_type_kind
) = OMP_CLAUSE_DEVICE_TYPE_HOST;
1502 break;
1503 case OMP_DEVICE_TYPE_NOHOST:
1504 OMP_CLAUSE_DEVICE_TYPE_KIND (c)((omp_clause_subcode_check ((c), (OMP_CLAUSE_DEVICE_TYPE), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1504, __FUNCTION__))->omp_clause.subcode.device_type_kind
) = OMP_CLAUSE_DEVICE_TYPE_NOHOST;
1505 break;
1506 case OMP_DEVICE_TYPE_ANY:
1507 OMP_CLAUSE_DEVICE_TYPE_KIND (c)((omp_clause_subcode_check ((c), (OMP_CLAUSE_DEVICE_TYPE), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1507, __FUNCTION__))->omp_clause.subcode.device_type_kind
) = OMP_CLAUSE_DEVICE_TYPE_ANY;
1508 break;
1509 default:
1510 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1510, __FUNCTION__));
1511 }
1512 OMP_CLAUSE_CHAIN (c)((contains_struct_check (((tree_check ((c), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1512, __FUNCTION__, (OMP_CLAUSE)))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1512, __FUNCTION__))->common.chain) = clauses;
1513 clauses = c;
1514 }
1515
1516 if (sym_attr.omp_declare_target_link
1517 || sym_attr.oacc_declare_link)
1518 list = tree_cons (get_identifier ("omp declare target link")(__builtin_constant_p ("omp declare target link") ? get_identifier_with_length
(("omp declare target link"), strlen ("omp declare target link"
)) : get_identifier ("omp declare target link")),
1519 clauses, list);
1520 else if (sym_attr.omp_declare_target
1521 || sym_attr.oacc_declare_create
1522 || sym_attr.oacc_declare_copyin
1523 || sym_attr.oacc_declare_deviceptr
1524 || sym_attr.oacc_declare_device_resident)
1525 list = tree_cons (get_identifier ("omp declare target")(__builtin_constant_p ("omp declare target") ? get_identifier_with_length
(("omp declare target"), strlen ("omp declare target")) : get_identifier
("omp declare target")),
1526 clauses, list);
1527
1528 return list;
1529}
1530
1531
1532static void build_function_decl (gfc_symbol * sym, bool global);
1533
1534
1535/* Return the decl for a gfc_symbol, create it if it doesn't already
1536 exist. */
1537
1538tree
1539gfc_get_symbol_decl (gfc_symbol * sym)
1540{
1541 tree decl;
1542 tree length = NULL_TREE(tree) __null;
1543 tree attributes;
1544 int byref;
1545 bool intrinsic_array_parameter = false;
1546 bool fun_or_res;
1547
1548 gcc_assert (sym->attr.referenced((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1554, __FUNCTION__), 0 : 0))
1549 || sym->attr.flavor == FL_PROCEDURE((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1554, __FUNCTION__), 0 : 0))
1550 || sym->attr.use_assoc((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1554, __FUNCTION__), 0 : 0))
1551 || sym->attr.used_in_submodule((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1554, __FUNCTION__), 0 : 0))
1552 || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1554, __FUNCTION__), 0 : 0))
1553 || (sym->module && sym->attr.if_source != IFSRC_DECL((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1554, __FUNCTION__), 0 : 0))
1554 && sym->backend_decl))((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1554, __FUNCTION__), 0 : 0));
1555
1556 if (sym->attr.dummy && sym->ns->proc_name->attr.is_bind_c
1557 && is_CFI_desc (sym, NULL__null))
1558 {
1559 gcc_assert (sym->backend_decl && (sym->ts.type != BT_CHARACTER((void)(!(sym->backend_decl && (sym->ts.type !=
BT_CHARACTER || sym->ts.u.cl->backend_decl)) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1560, __FUNCTION__), 0 : 0))
1560 || sym->ts.u.cl->backend_decl))((void)(!(sym->backend_decl && (sym->ts.type !=
BT_CHARACTER || sym->ts.u.cl->backend_decl)) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1560, __FUNCTION__), 0 : 0));
1561 return sym->backend_decl;
1562 }
1563
1564 if (sym->ns && sym->ns->proc_name && sym->ns->proc_name->attr.function)
1565 byref = gfc_return_by_reference (sym->ns->proc_name);
1566 else
1567 byref = 0;
1568
1569 /* Make sure that the vtab for the declared type is completed. */
1570 if (sym->ts.type == BT_CLASS)
1571 {
1572 gfc_component *c = CLASS_DATA (sym)sym->ts.u.derived->components;
1573 if (!c->ts.u.derived->backend_decl)
1574 {
1575 gfc_find_derived_vtab (c->ts.u.derived);
1576 gfc_get_derived_type (sym->ts.u.derived);
1577 }
1578 }
1579
1580 /* PDT parameterized array components and string_lengths must have the
1581 'len' parameters substituted for the expressions appearing in the
1582 declaration of the entity and memory allocated/deallocated. */
1583 if ((sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
1584 && sym->param_list != NULL__null
1585 && gfc_current_ns == sym->ns
1586 && !(sym->attr.use_assoc || sym->attr.dummy))
1587 gfc_defer_symbol_init (sym);
1588
1589 /* Dummy PDT 'len' parameters should be checked when they are explicit. */
1590 if ((sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
1591 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
1592 && sym->param_list != NULL__null
1593 && sym->attr.dummy)
1594 gfc_defer_symbol_init (sym);
1595
1596 /* All deferred character length procedures need to retain the backend
1597 decl, which is a pointer to the character length in the caller's
1598 namespace and to declare a local character length. */
1599 if (!byref && sym->attr.function
1600 && sym->ts.type == BT_CHARACTER
1601 && sym->ts.deferred
1602 && sym->ts.u.cl->passed_length == NULL__null
1603 && sym->ts.u.cl->backend_decl
1604 && TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == PARM_DECL)
1605 {
1606 sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
1607 gcc_assert (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length)))((void)(!((((enum tree_code) (((contains_struct_check ((sym->
ts.u.cl->passed_length), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1607, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((sym->ts.u
.cl->passed_length), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1607, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1607, __FUNCTION__), 0 : 0));
1608 sym->ts.u.cl->backend_decl = build_fold_indirect_ref (sym->ts.u.cl->backend_decl)build_fold_indirect_ref_loc (((location_t) 0), sym->ts.u.cl
->backend_decl);
1609 }
1610
1611 fun_or_res = byref && (sym->attr.result
1612 || (sym->attr.function && sym->ts.deferred));
1613 if ((sym->attr.dummy && ! sym->attr.function) || fun_or_res)
1614 {
1615 /* Return via extra parameter. */
1616 if (sym->attr.result && byref
1617 && !sym->backend_decl)
1618 {
1619 sym->backend_decl =
1620 DECL_ARGUMENTS (sym->ns->proc_name->backend_decl)((tree_check ((sym->ns->proc_name->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1620, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
);
1621 /* For entry master function skip over the __entry
1622 argument. */
1623 if (sym->ns->proc_name->attr.entry_master)
1624 sym->backend_decl = DECL_CHAIN (sym->backend_decl)(((contains_struct_check (((contains_struct_check ((sym->backend_decl
), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1624, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1624, __FUNCTION__))->common.chain));
1625 }
1626
1627 /* Dummy variables should already have been created. */
1628 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1628, __FUNCTION__), 0 : 0));
1629
1630 /* However, the string length of deferred arrays must be set. */
1631 if (sym->ts.type == BT_CHARACTER
1632 && sym->ts.deferred
1633 && sym->attr.dimension
1634 && sym->attr.allocatable)
1635 gfc_defer_symbol_init (sym);
1636
1637 if (sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)
1638 GFC_DECL_PTR_ARRAY_P (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1638, __FUNCTION__))->decl_common.lang_flag_6) = 1;
1639
1640 /* Create a character length variable. */
1641 if (sym->ts.type == BT_CHARACTER)
1642 {
1643 /* For a deferred dummy, make a new string length variable. */
1644 if (sym->ts.deferred
1645 &&
1646 (sym->ts.u.cl->passed_length == sym->ts.u.cl->backend_decl))
1647 sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
1648
1649 if (sym->ts.deferred && byref)
1650 {
1651 /* The string length of a deferred char array is stored in the
1652 parameter at sym->ts.u.cl->backend_decl as a reference and
1653 marked as a result. Exempt this variable from generating a
1654 temporary for it. */
1655 if (sym->attr.result)
1656 {
1657 /* We need to insert a indirect ref for param decls. */
1658 if (sym->ts.u.cl->backend_decl
1659 && TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == PARM_DECL)
1660 {
1661 sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
1662 sym->ts.u.cl->backend_decl =
1663 build_fold_indirect_ref (sym->ts.u.cl->backend_decl)build_fold_indirect_ref_loc (((location_t) 0), sym->ts.u.cl
->backend_decl);
1664 }
1665 }
1666 /* For all other parameters make sure, that they are copied so
1667 that the value and any modifications are local to the routine
1668 by generating a temporary variable. */
1669 else if (sym->attr.function
1670 && sym->ts.u.cl->passed_length == NULL__null
1671 && sym->ts.u.cl->backend_decl)
1672 {
1673 sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
1674 if (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length))(((enum tree_code) (((contains_struct_check ((sym->ts.u.cl
->passed_length), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1674, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((sym->ts.u
.cl->passed_length), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1674, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
))
1675 sym->ts.u.cl->backend_decl
1676 = build_fold_indirect_ref (sym->ts.u.cl->backend_decl)build_fold_indirect_ref_loc (((location_t) 0), sym->ts.u.cl
->backend_decl);
1677 else
1678 sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
1679 }
1680 }
1681
1682 if (sym->ts.u.cl->backend_decl == NULL_TREE(tree) __null)
1683 length = gfc_create_string_length (sym);
1684 else
1685 length = sym->ts.u.cl->backend_decl;
1686 if (VAR_P (length)(((enum tree_code) (length)->base.code) == VAR_DECL) && DECL_FILE_SCOPE_P (length)(! (((contains_struct_check ((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1686, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1686, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL))
1687 {
1688 /* Add the string length to the same context as the symbol. */
1689 if (DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1689, __FUNCTION__))->decl_minimal.context) == NULL_TREE(tree) __null)
1690 {
1691 if (sym->backend_decl == current_function_decl
1692 || (DECL_CONTEXT (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1692, __FUNCTION__))->decl_minimal.context)
1693 == current_function_decl))
1694 gfc_add_decl_to_function (length);
1695 else
1696 gfc_add_decl_to_parent_function (length);
1697 }
1698
1699 gcc_assert (sym->backend_decl == current_function_decl((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1700, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1701, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__), 0 : 0))
1700 ? DECL_CONTEXT (length) == current_function_decl((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1700, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1701, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__), 0 : 0))
1701 : (DECL_CONTEXT (sym->backend_decl)((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1700, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1701, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__), 0 : 0))
1702 == DECL_CONTEXT (length)))((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1700, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1701, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1702, __FUNCTION__), 0 : 0));
1703
1704 gfc_defer_symbol_init (sym);
1705 }
1706 }
1707
1708 /* Use a copy of the descriptor for dummy arrays. */
1709 if ((sym->attr.dimension || sym->attr.codimension)
1710 && !TREE_USED (sym->backend_decl)((sym->backend_decl)->base.used_flag))
1711 {
1712 decl = gfc_build_dummy_array_decl (sym, sym->backend_decl);
1713 /* Prevent the dummy from being detected as unused if it is copied. */
1714 if (sym->backend_decl != NULL__null && decl != sym->backend_decl)
1715 DECL_ARTIFICIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1715, __FUNCTION__))->decl_common.artificial_flag) = 1;
1716 sym->backend_decl = decl;
1717 }
1718
1719 /* Returning the descriptor for dummy class arrays is hazardous, because
1720 some caller is expecting an expression to apply the component refs to.
1721 Therefore the descriptor is only created and stored in
1722 sym->backend_decl's GFC_DECL_SAVED_DESCRIPTOR. The caller is then
1723 responsible to extract it from there, when the descriptor is
1724 desired. */
1725 if (IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer)
1726 && (!DECL_LANG_SPECIFIC (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1726, __FUNCTION__))->decl_common.lang_specific)
1727 || !GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl)(((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1727, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)))
1728 {
1729 decl = gfc_build_dummy_array_decl (sym, sym->backend_decl);
1730 /* Prevent the dummy from being detected as unused if it is copied. */
1731 if (sym->backend_decl != NULL__null && decl != sym->backend_decl)
1732 DECL_ARTIFICIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1732, __FUNCTION__))->decl_common.artificial_flag) = 1;
1733 sym->backend_decl = decl;
1734 }
1735
1736 TREE_USED (sym->backend_decl)((sym->backend_decl)->base.used_flag) = 1;
1737 if (sym->attr.assign && GFC_DECL_ASSIGN (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1737, __FUNCTION__))->decl_common.lang_flag_2) == 0)
1738 gfc_add_assign_aux_vars (sym);
1739
1740 if (sym->ts.type == BT_CLASS && sym->backend_decl)
1741 GFC_DECL_CLASS(sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1741, __FUNCTION__))->decl_common.lang_flag_8) = 1;
1742
1743 return sym->backend_decl;
1744 }
1745
1746 if (sym->result == sym && sym->attr.assign
1747 && GFC_DECL_ASSIGN (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1747, __FUNCTION__))->decl_common.lang_flag_2) == 0)
1748 gfc_add_assign_aux_vars (sym);
1749
1750 if (sym->backend_decl)
1751 return sym->backend_decl;
1752
1753 /* Special case for array-valued named constants from intrinsic
1754 procedures; those are inlined. */
1755 if (sym->attr.use_assoc && sym->attr.flavor == FL_PARAMETER
1756 && (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
1757 || sym->from_intmod == INTMOD_ISO_C_BINDING))
1758 intrinsic_array_parameter = true;
1759
1760 /* If use associated compilation, use the module
1761 declaration. */
1762 if ((sym->attr.flavor == FL_VARIABLE
1763 || sym->attr.flavor == FL_PARAMETER)
1764 && (sym->attr.use_assoc || sym->attr.used_in_submodule)
1765 && !intrinsic_array_parameter
1766 && sym->module
1767 && gfc_get_module_backend_decl (sym))
1768 {
1769 if (sym->ts.type == BT_CLASS && sym->backend_decl)
1770 GFC_DECL_CLASS(sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1770, __FUNCTION__))->decl_common.lang_flag_8) = 1;
1771 return sym->backend_decl;
1772 }
1773
1774 if (sym->attr.flavor == FL_PROCEDURE)
1775 {
1776 /* Catch functions. Only used for actual parameters,
1777 procedure pointers and procptr initialization targets. */
1778 if (sym->attr.use_assoc
1779 || sym->attr.used_in_submodule
1780 || sym->attr.intrinsic
1781 || sym->attr.if_source != IFSRC_DECL)
1782 {
1783 decl = gfc_get_extern_function_decl (sym);
1784 }
1785 else
1786 {
1787 if (!sym->backend_decl)
1788 build_function_decl (sym, false);
1789 decl = sym->backend_decl;
1790 }
1791 return decl;
1792 }
1793
1794 if (sym->attr.intrinsic)
1795 gfc_internal_error ("intrinsic variable which isn't a procedure");
1796
1797 /* Create string length decl first so that they can be used in the
1798 type declaration. For associate names, the target character
1799 length is used. Set 'length' to a constant so that if the
1800 string length is a variable, it is not finished a second time. */
1801 if (sym->ts.type == BT_CHARACTER)
1802 {
1803 if (sym->attr.associate_var
1804 && sym->ts.deferred
1805 && sym->assoc && sym->assoc->target
1806 && ((sym->assoc->target->expr_type == EXPR_VARIABLE
1807 && sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER)
1808 || sym->assoc->target->expr_type != EXPR_VARIABLE))
1809 sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
1810
1811 if (sym->attr.associate_var
1812 && sym->ts.u.cl->backend_decl
1813 && (VAR_P (sym->ts.u.cl->backend_decl)(((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == VAR_DECL)
1814 || TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == PARM_DECL))
1815 length = gfc_index_zero_nodegfc_rank_cst[0];
1816 else
1817 length = gfc_create_string_length (sym);
1818 }
1819
1820 /* Create the decl for the variable. */
1821 decl = build_decl (gfc_get_location (&sym->declared_at),
1822 VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
1823
1824 /* Add attributes to variables. Functions are handled elsewhere. */
1825 attributes = add_attributes_to_decl (sym->attr, NULL_TREE(tree) __null);
1826 decl_attributes (&decl, attributes, 0);
1827
1828 /* Symbols from modules should have their assembler names mangled.
1829 This is done here rather than in gfc_finish_var_decl because it
1830 is different for string length variables. */
1831 if (sym->module || sym->fn_result_spec)
1832 {
1833 gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
1834 if (sym->attr.use_assoc && !intrinsic_array_parameter)
1835 DECL_IGNORED_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1835, __FUNCTION__))->decl_common.ignored_flag) = 1;
1836 }
1837
1838 if (sym->attr.select_type_temporary)
1839 {
1840 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1840, __FUNCTION__))->decl_common.artificial_flag) = 1;
1841 DECL_IGNORED_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1841, __FUNCTION__))->decl_common.ignored_flag) = 1;
1842 }
1843
1844 if (sym->attr.dimension || sym->attr.codimension)
1845 {
1846 /* Create variables to hold the non-constant bits of array info. */
1847 gfc_build_qualified_array (decl, sym);
1848
1849 if (sym->attr.contiguous
1850 || ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer))
1851 GFC_DECL_PACKED_ARRAY (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1851, __FUNCTION__))->decl_common.lang_flag_0) = 1;
1852 }
1853
1854 /* Remember this variable for allocation/cleanup. */
1855 if (sym->attr.dimension || sym->attr.allocatable || sym->attr.codimension
1856 || (sym->ts.type == BT_CLASS &&
1857 (CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
1858 || CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable))
1859 || (sym->ts.type == BT_DERIVED
1860 && (sym->ts.u.derived->attr.alloc_comp
1861 || (!sym->attr.pointer && !sym->attr.artificial && !sym->attr.save
1862 && !sym->ns->proc_name->attr.is_main_program
1863 && gfc_is_finalizable (sym->ts.u.derived, NULL__null))))
1864 /* This applies a derived type default initializer. */
1865 || (sym->ts.type == BT_DERIVED
1866 && sym->attr.save == SAVE_NONE
1867 && !sym->attr.data
1868 && !sym->attr.allocatable
1869 && (sym->value && !sym->ns->proc_name->attr.is_main_program)
1870 && !(sym->attr.use_assoc && !intrinsic_array_parameter)))
1871 gfc_defer_symbol_init (sym);
1872
1873 if (sym->ts.type == BT_CHARACTER
1874 && sym->attr.allocatable
1875 && !sym->attr.dimension
1876 && sym->ts.u.cl && sym->ts.u.cl->length
1877 && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE)
1878 gfc_defer_symbol_init (sym);
1879
1880 /* Associate names can use the hidden string length variable
1881 of their associated target. */
1882 if (sym->ts.type == BT_CHARACTER
1883 && TREE_CODE (length)((enum tree_code) (length)->base.code) != INTEGER_CST
1884 && TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) != INDIRECT_REF)
1885 {
1886 length = fold_convert (gfc_charlen_type_node, length)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, length
);
1887 gfc_finish_var_decl (length, sym);
1888 if (!sym->attr.associate_var
1889 && TREE_CODE (length)((enum tree_code) (length)->base.code) == VAR_DECL
1890 && sym->value && sym->value->expr_type != EXPR_NULL
1891 && sym->value->ts.u.cl->length)
1892 {
1893 gfc_expr *len = sym->value->ts.u.cl->length;
1894 DECL_INITIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1894, __FUNCTION__))->decl_common.initial) = gfc_conv_initializer (len, &len->ts,
1895 TREE_TYPE (length)((contains_struct_check ((length), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1895, __FUNCTION__))->typed.type),
1896 false, false, false);
1897 DECL_INITIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1897, __FUNCTION__))->decl_common.initial) = fold_convert (gfc_charlen_type_node,fold_convert_loc (((location_t) 0), gfc_charlen_type_node, ((
contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1898, __FUNCTION__))->decl_common.initial))
1898 DECL_INITIAL (length))fold_convert_loc (((location_t) 0), gfc_charlen_type_node, ((
contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1898, __FUNCTION__))->decl_common.initial));
1899 }
1900 else
1901 gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL)((void)(!(!sym->value || sym->value->expr_type == EXPR_NULL
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1901, __FUNCTION__), 0 : 0));
1902 }
1903
1904 gfc_finish_var_decl (decl, sym);
1905
1906 if (sym->ts.type == BT_CHARACTER)
1907 /* Character variables need special handling. */
1908 gfc_allocate_lang_decl (decl);
1909
1910 if (sym->assoc && sym->attr.subref_array_pointer)
1911 sym->attr.pointer = 1;
1912
1913 if (sym->attr.pointer && sym->attr.dimension
1914 && !sym->ts.deferred
1915 && !(sym->attr.select_type_temporary
1916 && !sym->attr.subref_array_pointer))
1917 GFC_DECL_PTR_ARRAY_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1917, __FUNCTION__))->decl_common.lang_flag_6) = 1;
1918
1919 if (sym->ts.type == BT_CLASS)
1920 GFC_DECL_CLASS(decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1920, __FUNCTION__))->decl_common.lang_flag_8) = 1;
1921
1922 sym->backend_decl = decl;
1923
1924 if (sym->attr.assign)
1925 gfc_add_assign_aux_vars (sym);
1926
1927 if (intrinsic_array_parameter)
1928 {
1929 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
1930 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1930, __FUNCTION__))->decl_common.decl_flag_1) = 0;
1931 }
1932
1933 if (TREE_STATIC (decl)((decl)->base.static_flag)
1934 && !(sym->attr.use_assoc && !intrinsic_array_parameter)
1935 && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
1936 || !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1936, __FUNCTION__))->decl_common.size_unit))
1937 || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
1938 && (flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB
1939 || !sym->attr.codimension || sym->attr.allocatable)
1940 && !(sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_type)
1941 && !(sym->ts.type == BT_CLASS
1942 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived->attr.pdt_type))
1943 {
1944 /* Add static initializer. For procedures, it is only needed if
1945 SAVE is specified otherwise they need to be reinitialized
1946 every time the procedure is entered. The TREE_STATIC is
1947 in this case due to -fmax-stack-var-size=. */
1948
1949 DECL_INITIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1949, __FUNCTION__))->decl_common.initial) = gfc_conv_initializer (sym->value, &sym->ts,
1950 TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1950, __FUNCTION__))->typed.type), sym->attr.dimension
1951 || (sym->attr.codimension
1952 && sym->attr.allocatable),
1953 sym->attr.pointer || sym->attr.allocatable
1954 || sym->ts.type == BT_CLASS,
1955 sym->attr.proc_pointer);
1956 }
1957
1958 if (!TREE_STATIC (decl)((decl)->base.static_flag)
1959 && POINTER_TYPE_P (TREE_TYPE (decl))(((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1959, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1959, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)
1960 && !sym->attr.pointer
1961 && !sym->attr.allocatable
1962 && !sym->attr.proc_pointer
1963 && !sym->attr.select_type_temporary)
1964 DECL_BY_REFERENCE (decl)((tree_check3 ((decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1964, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL))
)->decl_common.decl_by_reference_flag) = 1;
1965
1966 if (sym->attr.associate_var)
1967 GFC_DECL_ASSOCIATE_VAR_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1967, __FUNCTION__))->decl_common.lang_flag_7) = 1;
1968
1969 /* We only longer mark __def_init as read-only if it actually has an
1970 initializer, it does not needlessly take up space in the
1971 read-only section and can go into the BSS instead, see PR 84487.
1972 Marking this as artificial means that OpenMP will treat this as
1973 predetermined shared. */
1974
1975 bool def_init = startswith (sym->name, "__def_init");
1976
1977 if (sym->attr.vtab || def_init)
1978 {
1979 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1979, __FUNCTION__))->decl_common.artificial_flag) = 1;
1980 if (def_init && sym->value)
1981 TREE_READONLY (decl)((non_type_check ((decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 1981, __FUNCTION__))->base.readonly_flag) = 1;
1982 }
1983
1984 return decl;
1985}
1986
1987
1988/* Substitute a temporary variable in place of the real one. */
1989
1990void
1991gfc_shadow_sym (gfc_symbol * sym, tree decl, gfc_saved_var * save)
1992{
1993 save->attr = sym->attr;
1994 save->decl = sym->backend_decl;
1995
1996 gfc_clear_attr (&sym->attr);
1997 sym->attr.referenced = 1;
1998 sym->attr.flavor = FL_VARIABLE;
1999
2000 sym->backend_decl = decl;
2001}
2002
2003
2004/* Restore the original variable. */
2005
2006void
2007gfc_restore_sym (gfc_symbol * sym, gfc_saved_var * save)
2008{
2009 sym->attr = save->attr;
2010 sym->backend_decl = save->decl;
2011}
2012
2013
2014/* Declare a procedure pointer. */
2015
2016static tree
2017get_proc_pointer_decl (gfc_symbol *sym)
2018{
2019 tree decl;
2020 tree attributes;
2021
2022 if (sym->module || sym->fn_result_spec)
2023 {
2024 const char *name;
2025 gfc_gsymbol *gsym;
2026
2027 name = mangled_identifier (sym);
2028 gsym = gfc_find_gsymbol (gfc_gsym_root, name);
2029 if (gsym != NULL__null)
2030 {
2031 gfc_symbol *s;
2032 gfc_find_symbol (sym->name, gsym->ns, 0, &s);
2033 if (s && s->backend_decl)
2034 return s->backend_decl;
2035 }
2036 }
2037
2038 decl = sym->backend_decl;
2039 if (decl)
2040 return decl;
2041
2042 decl = build_decl (input_location,
2043 VAR_DECL, get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name)),
2044 build_pointer_type (gfc_get_function_type (sym)));
2045
2046 if (sym->module)
2047 {
2048 /* Apply name mangling. */
2049 gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
2050 if (sym->attr.use_assoc)
2051 DECL_IGNORED_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2051, __FUNCTION__))->decl_common.ignored_flag) = 1;
2052 }
2053
2054 if ((sym->ns->proc_name
2055 && sym->ns->proc_name->backend_decl == current_function_decl)
2056 || sym->attr.contained)
2057 gfc_add_decl_to_function (decl);
2058 else if (sym->ns->proc_name->attr.flavor != FL_MODULE)
2059 gfc_add_decl_to_parent_function (decl);
2060
2061 sym->backend_decl = decl;
2062
2063 /* If a variable is USE associated, it's always external. */
2064 if (sym->attr.use_assoc)
2065 {
2066 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2066, __FUNCTION__))->decl_common.decl_flag_1) = 1;
2067 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
2068 }
2069 else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE)
2070 {
2071 /* This is the declaration of a module variable. */
2072 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
2073 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
2074 {
2075 DECL_VISIBILITY (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2075, __FUNCTION__))->decl_with_vis.visibility) = VISIBILITY_HIDDEN;
2076 DECL_VISIBILITY_SPECIFIED (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2076, __FUNCTION__))->decl_with_vis.visibility_specified
) = true;
2077 }
2078 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
2079 }
2080
2081 if (!sym->attr.use_assoc
2082 && (sym->attr.save != SAVE_NONE || sym->attr.data
2083 || (sym->value && sym->ns->proc_name->attr.is_main_program)))
2084 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
2085
2086 if (TREE_STATIC (decl)((decl)->base.static_flag) && sym->value)
2087 {
2088 /* Add static initializer. */
2089 DECL_INITIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2089, __FUNCTION__))->decl_common.initial) = gfc_conv_initializer (sym->value, &sym->ts,
2090 TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2090, __FUNCTION__))->typed.type),
2091 sym->attr.dimension,
2092 false, true);
2093 }
2094
2095 /* Handle threadprivate procedure pointers. */
2096 if (sym->attr.threadprivate
2097 && (TREE_STATIC (decl)((decl)->base.static_flag) || DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2097, __FUNCTION__))->decl_common.decl_flag_1)))
2098 set_decl_tls_model (decl, decl_default_tls_model (decl));
2099
2100 attributes = add_attributes_to_decl (sym->attr, NULL_TREE(tree) __null);
2101 decl_attributes (&decl, attributes, 0);
2102
2103 return decl;
2104}
2105
2106
2107/* Get a basic decl for an external function. */
2108
2109tree
2110gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args,
2111 const char *fnspec)
2112{
2113 tree type;
2114 tree fndecl;
2115 tree attributes;
2116 gfc_expr e;
2117 gfc_intrinsic_sym *isym;
2118 gfc_expr argexpr;
2119 char s[GFC_MAX_SYMBOL_LEN63 + 23]; /* "_gfortran_f2c_specific" and '\0'. */
2120 tree name;
2121 tree mangled_name;
2122 gfc_gsymbol *gsym;
2123
2124 if (sym->backend_decl)
2125 return sym->backend_decl;
2126
2127 /* We should never be creating external decls for alternate entry points.
2128 The procedure may be an alternate entry point, but we don't want/need
2129 to know that. */
2130 gcc_assert (!(sym->attr.entry || sym->attr.entry_master))((void)(!(!(sym->attr.entry || sym->attr.entry_master))
? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2130, __FUNCTION__), 0 : 0));
2131
2132 if (sym->attr.proc_pointer)
2133 return get_proc_pointer_decl (sym);
2134
2135 /* See if this is an external procedure from the same file. If so,
2136 return the backend_decl. If we are looking at a BIND(C)
2137 procedure and the symbol is not BIND(C), or vice versa, we
2138 haven't found the right procedure. */
2139
2140 if (sym->binding_label)
2141 {
2142 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label);
2143 if (gsym && !gsym->bind_c)
2144 gsym = NULL__null;
2145 }
2146 else if (sym->module == NULL__null)
2147 {
2148 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name);
2149 if (gsym && gsym->bind_c)
2150 gsym = NULL__null;
2151 }
2152 else
2153 {
2154 /* Procedure from a different module. */
2155 gsym = NULL__null;
2156 }
2157
2158 if (gsym && !gsym->defined)
2159 gsym = NULL__null;
2160
2161 /* This can happen because of C binding. */
2162 if (gsym && gsym->ns && gsym->ns->proc_name
2163 && gsym->ns->proc_name->attr.flavor == FL_MODULE)
2164 goto module_sym;
2165
2166 if ((!sym->attr.use_assoc || sym->attr.if_source != IFSRC_DECL)
2167 && !sym->backend_decl
2168 && gsym && gsym->ns
2169 && ((gsym->type == GSYM_SUBROUTINE) || (gsym->type == GSYM_FUNCTION))
2170 && (gsym->ns->proc_name->backend_decl || !sym->attr.intrinsic))
2171 {
2172 if (!gsym->ns->proc_name->backend_decl)
2173 {
2174 /* By construction, the external function cannot be
2175 a contained procedure. */
2176 locus old_loc;
2177
2178 gfc_save_backend_locus (&old_loc);
2179 push_cfun (NULL__null);
2180
2181 gfc_create_function_decl (gsym->ns, true);
2182
2183 pop_cfun ();
2184 gfc_restore_backend_locus (&old_loc);
2185 }
2186
2187 /* If the namespace has entries, the proc_name is the
2188 entry master. Find the entry and use its backend_decl.
2189 otherwise, use the proc_name backend_decl. */
2190 if (gsym->ns->entries)
2191 {
2192 gfc_entry_list *entry = gsym->ns->entries;
2193
2194 for (; entry; entry = entry->next)
2195 {
2196 if (strcmp (gsym->name, entry->sym->name) == 0)
2197 {
2198 sym->backend_decl = entry->sym->backend_decl;
2199 break;
2200 }
2201 }
2202 }
2203 else
2204 sym->backend_decl = gsym->ns->proc_name->backend_decl;
2205
2206 if (sym->backend_decl)
2207 {
2208 /* Avoid problems of double deallocation of the backend declaration
2209 later in gfc_trans_use_stmts; cf. PR 45087. */
2210 if (sym->attr.if_source != IFSRC_DECL && sym->attr.use_assoc)
2211 sym->attr.use_assoc = 0;
2212
2213 return sym->backend_decl;
2214 }
2215 }
2216
2217 /* See if this is a module procedure from the same file. If so,
2218 return the backend_decl. */
2219 if (sym->module)
2220 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module);
2221
2222module_sym:
2223 if (gsym && gsym->ns
2224 && (gsym->type == GSYM_MODULE
2225 || (gsym->ns->proc_name && gsym->ns->proc_name->attr.flavor == FL_MODULE)))
2226 {
2227 gfc_symbol *s;
2228
2229 s = NULL__null;
2230 if (gsym->type == GSYM_MODULE)
2231 gfc_find_symbol (sym->name, gsym->ns, 0, &s);
2232 else
2233 gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &s);
2234
2235 if (s && s->backend_decl)
2236 {
2237 if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
2238 gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived,
2239 true);
2240 else if (sym->ts.type == BT_CHARACTER)
2241 sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;
2242 sym->backend_decl = s->backend_decl;
2243 return sym->backend_decl;
2244 }
2245 }
2246
2247 if (sym->attr.intrinsic)
2248 {
2249 /* Call the resolution function to get the actual name. This is
2250 a nasty hack which relies on the resolution functions only looking
2251 at the first argument. We pass NULL for the second argument
2252 otherwise things like AINT get confused. */
2253 isym = gfc_find_function (sym->name);
2254 gcc_assert (isym->resolve.f0 != NULL)((void)(!(isym->resolve.f0 != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2254, __FUNCTION__), 0 : 0));
2255
2256 memset (&e, 0, sizeof (e));
2257 e.expr_type = EXPR_FUNCTION;
2258
2259 memset (&argexpr, 0, sizeof (argexpr));
2260 gcc_assert (isym->formal)((void)(!(isym->formal) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2260, __FUNCTION__), 0 : 0));
2261 argexpr.ts = isym->formal->ts;
2262
2263 if (isym->formal->next == NULL__null)
2264 isym->resolve.f1 (&e, &argexpr);
2265 else
2266 {
2267 if (isym->formal->next->next == NULL__null)
2268 isym->resolve.f2 (&e, &argexpr, NULL__null);
2269 else
2270 {
2271 if (isym->formal->next->next->next == NULL__null)
2272 isym->resolve.f3 (&e, &argexpr, NULL__null, NULL__null);
2273 else
2274 {
2275 /* All specific intrinsics take less than 5 arguments. */
2276 gcc_assert (isym->formal->next->next->next->next == NULL)((void)(!(isym->formal->next->next->next->next
== __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2276, __FUNCTION__), 0 : 0));
2277 isym->resolve.f4 (&e, &argexpr, NULL__null, NULL__null, NULL__null);
2278 }
2279 }
2280 }
2281
2282 if (flag_f2cglobal_options.x_flag_f2c
2283 && ((e.ts.type == BT_REAL && e.ts.kind == gfc_default_real_kind)
2284 || e.ts.type == BT_COMPLEX))
2285 {
2286 /* Specific which needs a different implementation if f2c
2287 calling conventions are used. */
2288 sprintf (s, "_gfortran_f2c_specific%s", e.value.function.name);
2289 }
2290 else
2291 sprintf (s, "_gfortran_specific%s", e.value.function.name);
2292
2293 name = get_identifier (s)(__builtin_constant_p (s) ? get_identifier_with_length ((s), strlen
(s)) : get_identifier (s));
2294 mangled_name = name;
2295 }
2296 else
2297 {
2298 name = gfc_sym_identifier (sym);
2299 mangled_name = gfc_sym_mangled_function_id (sym);
2300 }
2301
2302 type = gfc_get_function_type (sym, actual_args, fnspec);
2303
2304 fndecl = build_decl (input_location,
2305 FUNCTION_DECL, name, type);
2306
2307 /* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes;
2308 TREE_PUBLIC specifies whether a function is globally addressable (i.e.
2309 the opposite of declaring a function as static in C). */
2310 DECL_EXTERNAL (fndecl)((contains_struct_check ((fndecl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2310, __FUNCTION__))->decl_common.decl_flag_1) = 1;
2311 TREE_PUBLIC (fndecl)((fndecl)->base.public_flag) = 1;
2312
2313 attributes = add_attributes_to_decl (sym->attr, NULL_TREE(tree) __null);
2314 decl_attributes (&fndecl, attributes, 0);
2315
2316 gfc_set_decl_assembler_name (fndecl, mangled_name);
2317
2318 /* Set the context of this decl. */
2319 if (0 && sym->ns && sym->ns->proc_name)
2320 {
2321 /* TODO: Add external decls to the appropriate scope. */
2322 DECL_CONTEXT (fndecl)((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2322, __FUNCTION__))->decl_minimal.context) = sym->ns->proc_name->backend_decl;
2323 }
2324 else
2325 {
2326 /* Global declaration, e.g. intrinsic subroutine. */
2327 DECL_CONTEXT (fndecl)((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2327, __FUNCTION__))->decl_minimal.context) = NULL_TREE(tree) __null;
2328 }
2329
2330 /* Set attributes for PURE functions. A call to PURE function in the
2331 Fortran 95 sense is both pure and without side effects in the C
2332 sense. */
2333 if (sym->attr.pure || sym->attr.implicit_pure)
2334 {
2335 if (sym->attr.function && !gfc_return_by_reference (sym))
2336 DECL_PURE_P (fndecl)((tree_check ((fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2336, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
2337 /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT)
2338 parameters and don't use alternate returns (is this
2339 allowed?). In that case, calls to them are meaningless, and
2340 can be optimized away. See also in build_function_decl(). */
2341 TREE_SIDE_EFFECTS (fndecl)((non_type_check ((fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2341, __FUNCTION__))->base.side_effects_flag) = 0;
2342 }
2343
2344 /* Mark non-returning functions. */
2345 if (sym->attr.noreturn || sym->attr.ext_attr & (1 << EXT_ATTR_NORETURN))
2346 TREE_THIS_VOLATILE(fndecl)((fndecl)->base.volatile_flag) = 1;
2347
2348 sym->backend_decl = fndecl;
2349
2350 if (DECL_CONTEXT (fndecl)((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2350, __FUNCTION__))->decl_minimal.context) == NULL_TREE(tree) __null)
2351 pushdecl_top_level (fndecl);
2352
2353 if (sym->formal_ns
2354 && sym->formal_ns->proc_name == sym)
2355 {
2356 if (sym->formal_ns->omp_declare_simd)
2357 gfc_trans_omp_declare_simd (sym->formal_ns);
2358 if (flag_openmpglobal_options.x_flag_openmp)
2359 gfc_trans_omp_declare_variant (sym->formal_ns);
2360 }
2361
2362 return fndecl;
2363}
2364
2365
2366/* Create a declaration for a procedure. For external functions (in the C
2367 sense) use gfc_get_extern_function_decl. HAS_ENTRIES is true if this is
2368 a master function with alternate entry points. */
2369
2370static void
2371build_function_decl (gfc_symbol * sym, bool global)
2372{
2373 tree fndecl, type, attributes;
2374 symbol_attribute attr;
2375 tree result_decl;
2376 gfc_formal_arglist *f;
2377
2378 bool module_procedure = sym->attr.module_procedure
2379 && sym->ns
2380 && sym->ns->proc_name
2381 && sym->ns->proc_name->attr.flavor == FL_MODULE;
2382
2383 gcc_assert (!sym->attr.external || module_procedure)((void)(!(!sym->attr.external || module_procedure) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2383, __FUNCTION__), 0 : 0));
2384
2385 if (sym->backend_decl)
2386 return;
2387
2388 /* Set the line and filename. sym->declared_at seems to point to the
2389 last statement for subroutines, but it'll do for now. */
2390 gfc_set_backend_locus (&sym->declared_at);
2391
2392 /* Allow only one nesting level. Allow public declarations. */
2393 gcc_assert (current_function_decl == NULL_TREE((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2395, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2396, __FUNCTION__), 0 : 0))
2394 || DECL_FILE_SCOPE_P (current_function_decl)((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2395, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2396, __FUNCTION__), 0 : 0))
2395 || (TREE_CODE (DECL_CONTEXT (current_function_decl))((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2395, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2396, __FUNCTION__), 0 : 0))
2396 == NAMESPACE_DECL))((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2394, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2395, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2396, __FUNCTION__), 0 : 0));
2397
2398 type = gfc_get_function_type (sym);
2399 fndecl = build_decl (input_location,
2400 FUNCTION_DECL, gfc_sym_identifier (sym), type);
2401
2402 attr = sym->attr;
2403
2404 /* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes;
2405 TREE_PUBLIC specifies whether a function is globally addressable (i.e.
2406 the opposite of declaring a function as static in C). */
2407 DECL_EXTERNAL (fndecl)((contains_struct_check ((fndecl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2407, __FUNCTION__))->decl_common.decl_flag_1) = 0;
2408
2409 if (sym->attr.access == ACCESS_UNKNOWN && sym->module
2410 && (sym->ns->default_access == ACCESS_PRIVATE
2411 || (sym->ns->default_access == ACCESS_UNKNOWN
2412 && flag_module_privateglobal_options.x_flag_module_private)))
2413 sym->attr.access = ACCESS_PRIVATE;
2414
2415 if (!current_function_decl
2416 && !sym->attr.entry_master && !sym->attr.is_main_program
2417 && (sym->attr.access != ACCESS_PRIVATE || sym->binding_label
2418 || sym->attr.public_used))
2419 TREE_PUBLIC (fndecl)((fndecl)->base.public_flag) = 1;
2420
2421 if (sym->attr.referenced || sym->attr.entry_master)
2422 TREE_USED (fndecl)((fndecl)->base.used_flag) = 1;
2423
2424 attributes = add_attributes_to_decl (attr, NULL_TREE(tree) __null);
2425 decl_attributes (&fndecl, attributes, 0);
2426
2427 /* Figure out the return type of the declared function, and build a
2428 RESULT_DECL for it. If this is a subroutine with alternate
2429 returns, build a RESULT_DECL for it. */
2430 result_decl = NULL_TREE(tree) __null;
2431 /* TODO: Shouldn't this just be TREE_TYPE (TREE_TYPE (fndecl)). */
2432 if (attr.function)
2433 {
2434 if (gfc_return_by_reference (sym))
2435 type = void_type_nodeglobal_trees[TI_VOID_TYPE];
2436 else
2437 {
2438 if (sym->result != sym)
2439 result_decl = gfc_sym_identifier (sym->result);
2440
2441 type = TREE_TYPE (TREE_TYPE (fndecl))((contains_struct_check ((((contains_struct_check ((fndecl), (
TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2441, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2441, __FUNCTION__))->typed.type);
2442 }
2443 }
2444 else
2445 {
2446 /* Look for alternate return placeholders. */
2447 int has_alternate_returns = 0;
2448 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2449 {
2450 if (f->sym == NULL__null)
2451 {
2452 has_alternate_returns = 1;
2453 break;
2454 }
2455 }
2456
2457 if (has_alternate_returns)
2458 type = integer_type_nodeinteger_types[itk_int];
2459 else
2460 type = void_type_nodeglobal_trees[TI_VOID_TYPE];
2461 }
2462
2463 result_decl = build_decl (input_location,
2464 RESULT_DECL, result_decl, type);
2465 DECL_ARTIFICIAL (result_decl)((contains_struct_check ((result_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2465, __FUNCTION__))->decl_common.artificial_flag) = 1;
2466 DECL_IGNORED_P (result_decl)((contains_struct_check ((result_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2466, __FUNCTION__))->decl_common.ignored_flag) = 1;
2467 DECL_CONTEXT (result_decl)((contains_struct_check ((result_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2467, __FUNCTION__))->decl_minimal.context) = fndecl;
2468 DECL_RESULT (fndecl)((tree_check ((fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2468, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
) = result_decl;
2469
2470 /* Don't call layout_decl for a RESULT_DECL.
2471 layout_decl (result_decl, 0); */
2472
2473 /* TREE_STATIC means the function body is defined here. */
2474 TREE_STATIC (fndecl)((fndecl)->base.static_flag) = 1;
2475
2476 /* Set attributes for PURE functions. A call to a PURE function in the
2477 Fortran 95 sense is both pure and without side effects in the C
2478 sense. */
2479 if (attr.pure || attr.implicit_pure)
2480 {
2481 /* TODO: check if a pure SUBROUTINE has no INTENT(OUT) arguments
2482 including an alternate return. In that case it can also be
2483 marked as PURE. See also in gfc_get_extern_function_decl(). */
2484 if (attr.function && !gfc_return_by_reference (sym))
2485 DECL_PURE_P (fndecl)((tree_check ((fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2485, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
2486 TREE_SIDE_EFFECTS (fndecl)((non_type_check ((fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2486, __FUNCTION__))->base.side_effects_flag) = 0;
2487 }
2488
2489 /* Mark noinline functions. */
2490 if (attr.ext_attr & (1 << EXT_ATTR_NOINLINE))
2491 DECL_UNINLINABLE (fndecl)((tree_check ((fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2491, __FUNCTION__, (FUNCTION_DECL)))->function_decl.uninlinable
) = 1;
2492
2493 /* Mark noreturn functions. */
2494 if (attr.ext_attr & (1 << EXT_ATTR_NORETURN))
2495 TREE_THIS_VOLATILE (fndecl)((fndecl)->base.volatile_flag) = 1;
2496
2497 /* Mark weak functions. */
2498 if (attr.ext_attr & (1 << EXT_ATTR_WEAK))
2499 declare_weak (fndecl);
2500
2501 /* Layout the function declaration and put it in the binding level
2502 of the current function. */
2503
2504 if (global)
2505 pushdecl_top_level (fndecl);
2506 else
2507 pushdecl (fndecl);
2508
2509 /* Perform name mangling if this is a top level or module procedure. */
2510 if (current_function_decl == NULL_TREE(tree) __null)
2511 gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym));
2512
2513 sym->backend_decl = fndecl;
2514}
2515
2516
2517/* Create the DECL_ARGUMENTS for a procedure.
2518 NOTE: The arguments added here must match the argument type created by
2519 gfc_get_function_type (). */
2520
2521static void
2522create_function_arglist (gfc_symbol * sym)
2523{
2524 tree fndecl;
2525 gfc_formal_arglist *f;
2526 tree typelist, hidden_typelist, optval_typelist;
2527 tree arglist, hidden_arglist, optval_arglist;
2528 tree type;
2529 tree parm;
2530
2531 fndecl = sym->backend_decl;
2532
2533 /* Build formal argument list. Make sure that their TREE_CONTEXT is
2534 the new FUNCTION_DECL node. */
2535 arglist = NULL_TREE(tree) __null;
2536 hidden_arglist = NULL_TREE(tree) __null;
2537 optval_arglist = NULL_TREE(tree) __null;
2538 typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl))((tree_check2 ((((contains_struct_check ((fndecl), (TS_TYPED)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2538, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2538, __FUNCTION__, (FUNCTION_TYPE), (METHOD_TYPE)))->type_non_common
.values);
2539
2540 if (sym->attr.entry_master)
2541 {
2542 type = TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2542, __FUNCTION__, (TREE_LIST)))->list.value);
2543 parm = build_decl (input_location,
2544 PARM_DECL, get_identifier ("__entry")(__builtin_constant_p ("__entry") ? get_identifier_with_length
(("__entry"), strlen ("__entry")) : get_identifier ("__entry"
)), type);
2545
2546 DECL_CONTEXT (parm)((contains_struct_check ((parm), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2546, __FUNCTION__))->decl_minimal.context) = fndecl;
2547 DECL_ARG_TYPE (parm)((tree_check ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2547, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = type;
2548 TREE_READONLY (parm)((non_type_check ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2548, __FUNCTION__))->base.readonly_flag) = 1;
2549 gfc_finish_decl (parm);
2550 DECL_ARTIFICIAL (parm)((contains_struct_check ((parm), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2550, __FUNCTION__))->decl_common.artificial_flag) = 1;
2551
2552 arglist = chainon (arglist, parm);
2553 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2553, __FUNCTION__))->common.chain);
2554 }
2555
2556 if (gfc_return_by_reference (sym))
2557 {
2558 tree type = TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2558, __FUNCTION__, (TREE_LIST)))->list.value), length = NULL__null;
2559
2560 if (sym->ts.type == BT_CHARACTER)
2561 {
2562 /* Length of character result. */
2563 tree len_type = TREE_VALUE (TREE_CHAIN (typelist))((tree_check ((((contains_struct_check ((typelist), (TS_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2563, __FUNCTION__))->common.chain)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2563, __FUNCTION__, (TREE_LIST)))->list.value);
2564
2565 length = build_decl (input_location,
2566 PARM_DECL,
2567 get_identifier (".__result")(__builtin_constant_p (".__result") ? get_identifier_with_length
((".__result"), strlen (".__result")) : get_identifier (".__result"
)),
2568 len_type);
2569 if (POINTER_TYPE_P (len_type)(((enum tree_code) (len_type)->base.code) == POINTER_TYPE ||
((enum tree_code) (len_type)->base.code) == REFERENCE_TYPE
))
2570 {
2571 sym->ts.u.cl->passed_length = length;
2572 TREE_USED (length)((length)->base.used_flag) = 1;
2573 }
2574 else if (!sym->ts.u.cl->length)
2575 {
2576 sym->ts.u.cl->backend_decl = length;
2577 TREE_USED (length)((length)->base.used_flag) = 1;
2578 }
2579 gcc_assert (TREE_CODE (length) == PARM_DECL)((void)(!(((enum tree_code) (length)->base.code) == PARM_DECL
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2579, __FUNCTION__), 0 : 0));
2580 DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2580, __FUNCTION__))->decl_minimal.context) = fndecl;
2581 DECL_ARG_TYPE (length)((tree_check ((length), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2581, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = len_type;
2582 TREE_READONLY (length)((non_type_check ((length), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2582, __FUNCTION__))->base.readonly_flag) = 1;
2583 DECL_ARTIFICIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2583, __FUNCTION__))->decl_common.artificial_flag) = 1;
2584 gfc_finish_decl (length);
2585 if (sym->ts.u.cl->backend_decl == NULL__null
2586 || sym->ts.u.cl->backend_decl == length)
2587 {
2588 gfc_symbol *arg;
2589 tree backend_decl;
2590
2591 if (sym->ts.u.cl->backend_decl == NULL__null)
2592 {
2593 tree len = build_decl (input_location,
2594 VAR_DECL,
2595 get_identifier ("..__result")(__builtin_constant_p ("..__result") ? get_identifier_with_length
(("..__result"), strlen ("..__result")) : get_identifier ("..__result"
)),
2596 gfc_charlen_type_node);
2597 DECL_ARTIFICIAL (len)((contains_struct_check ((len), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2597, __FUNCTION__))->decl_common.artificial_flag) = 1;
2598 TREE_USED (len)((len)->base.used_flag) = 1;
2599 sym->ts.u.cl->backend_decl = len;
2600 }
2601
2602 /* Make sure PARM_DECL type doesn't point to incomplete type. */
2603 arg = sym->result ? sym->result : sym;
2604 backend_decl = arg->backend_decl;
2605 /* Temporary clear it, so that gfc_sym_type creates complete
2606 type. */
2607 arg->backend_decl = NULL__null;
2608 type = gfc_sym_type (arg);
2609 arg->backend_decl = backend_decl;
2610 type = build_reference_type (type);
2611 }
2612 }
2613
2614 parm = build_decl (input_location,
2615 PARM_DECL, get_identifier ("__result")(__builtin_constant_p ("__result") ? get_identifier_with_length
(("__result"), strlen ("__result")) : get_identifier ("__result"
)), type);
2616
2617 DECL_CONTEXT (parm)((contains_struct_check ((parm), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2617, __FUNCTION__))->decl_minimal.context) = fndecl;
2618 DECL_ARG_TYPE (parm)((tree_check ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2618, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2618, __FUNCTION__, (TREE_LIST)))->list.value);
2619 TREE_READONLY (parm)((non_type_check ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2619, __FUNCTION__))->base.readonly_flag) = 1;
2620 DECL_ARTIFICIAL (parm)((contains_struct_check ((parm), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2620, __FUNCTION__))->decl_common.artificial_flag) = 1;
2621 gfc_finish_decl (parm);
2622
2623 arglist = chainon (arglist, parm);
2624 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2624, __FUNCTION__))->common.chain);
2625
2626 if (sym->ts.type == BT_CHARACTER)
2627 {
2628 gfc_allocate_lang_decl (parm);
2629 arglist = chainon (arglist, length);
2630 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2630, __FUNCTION__))->common.chain);
2631 }
2632 }
2633
2634 hidden_typelist = typelist;
2635 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2636 if (f->sym != NULL__null) /* Ignore alternate returns. */
2637 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2637, __FUNCTION__))->common.chain);
2638
2639 /* Advance hidden_typelist over optional+value argument presence flags. */
2640 optval_typelist = hidden_typelist;
2641 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2642 if (f->sym != NULL__null
2643 && f->sym->attr.optional && f->sym->attr.value
2644 && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
2645 && !gfc_bt_struct (f->sym->ts.type)((f->sym->ts.type) == BT_DERIVED || (f->sym->ts.type
) == BT_UNION))
2646 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2646, __FUNCTION__))->common.chain);
2647
2648 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2649 {
2650 char name[GFC_MAX_SYMBOL_LEN63 + 2];
2651
2652 /* Ignore alternate returns. */
2653 if (f->sym == NULL__null)
2654 continue;
2655
2656 type = TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2656, __FUNCTION__, (TREE_LIST)))->list.value);
2657
2658 if (f->sym->ts.type == BT_CHARACTER
2659 && (!sym->attr.is_bind_c || sym->attr.entry_master))
2660 {
2661 tree len_type = TREE_VALUE (hidden_typelist)((tree_check ((hidden_typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2661, __FUNCTION__, (TREE_LIST)))->list.value);
2662 tree length = NULL_TREE(tree) __null;
2663 if (!f->sym->ts.deferred)
2664 gcc_assert (len_type == gfc_charlen_type_node)((void)(!(len_type == gfc_charlen_type_node) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2664, __FUNCTION__), 0 : 0));
2665 else
2666 gcc_assert (POINTER_TYPE_P (len_type))((void)(!((((enum tree_code) (len_type)->base.code) == POINTER_TYPE
|| ((enum tree_code) (len_type)->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2666, __FUNCTION__), 0 : 0));
2667
2668 strcpy (&name[1], f->sym->name);
2669 name[0] = '_';
2670 length = build_decl (input_location,
2671 PARM_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)), len_type);
2672
2673 hidden_arglist = chainon (hidden_arglist, length);
2674 DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2674, __FUNCTION__))->decl_minimal.context) = fndecl;
2675 DECL_ARTIFICIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2675, __FUNCTION__))->decl_common.artificial_flag) = 1;
2676 DECL_ARG_TYPE (length)((tree_check ((length), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2676, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = len_type;
2677 TREE_READONLY (length)((non_type_check ((length), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2677, __FUNCTION__))->base.readonly_flag) = 1;
2678 gfc_finish_decl (length);
2679
2680 /* Marking the length DECL_HIDDEN_STRING_LENGTH will lead
2681 to tail calls being disabled. Only do that if we
2682 potentially have broken callers. */
2683 if (flag_tail_call_workaroundglobal_options.x_flag_tail_call_workaround
2684 && f->sym->ts.u.cl
2685 && f->sym->ts.u.cl->length
2686 && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
2687 && (flag_tail_call_workaroundglobal_options.x_flag_tail_call_workaround == 2
2688 || f->sym->ns->implicit_interface_calls))
2689 DECL_HIDDEN_STRING_LENGTH (length)((tree_check ((length), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2689, __FUNCTION__, (PARM_DECL)))->decl_common.decl_nonshareable_flag
) = 1;
2690
2691 /* Remember the passed value. */
2692 if (!f->sym->ts.u.cl || f->sym->ts.u.cl->passed_length)
2693 {
2694 /* This can happen if the same type is used for multiple
2695 arguments. We need to copy cl as otherwise
2696 cl->passed_length gets overwritten. */
2697 f->sym->ts.u.cl = gfc_new_charlen (f->sym->ns, f->sym->ts.u.cl);
2698 }
2699 f->sym->ts.u.cl->passed_length = length;
2700
2701 /* Use the passed value for assumed length variables. */
2702 if (!f->sym->ts.u.cl->length)
2703 {
2704 TREE_USED (length)((length)->base.used_flag) = 1;
2705 gcc_assert (!f->sym->ts.u.cl->backend_decl)((void)(!(!f->sym->ts.u.cl->backend_decl) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2705, __FUNCTION__), 0 : 0));
2706 f->sym->ts.u.cl->backend_decl = length;
2707 }
2708
2709 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2709, __FUNCTION__))->common.chain);
2710
2711 if (f->sym->ts.u.cl->backend_decl == NULL__null
2712 || f->sym->ts.u.cl->backend_decl == length)
2713 {
2714 if (POINTER_TYPE_P (len_type)(((enum tree_code) (len_type)->base.code) == POINTER_TYPE ||
((enum tree_code) (len_type)->base.code) == REFERENCE_TYPE
))
2715 f->sym->ts.u.cl->backend_decl
2716 = build_fold_indirect_ref_loc (input_location, length);
2717 else if (f->sym->ts.u.cl->backend_decl == NULL__null)
2718 gfc_create_string_length (f->sym);
2719
2720 /* Make sure PARM_DECL type doesn't point to incomplete type. */
2721 if (f->sym->attr.flavor == FL_PROCEDURE)
2722 type = build_pointer_type (gfc_get_function_type (f->sym));
2723 else
2724 type = gfc_sym_type (f->sym);
2725 }
2726 }
2727 /* For scalar intrinsic types, VALUE passes the value,
2728 hence, the optional status cannot be transferred via a NULL pointer.
2729 Thus, we will use a hidden argument in that case. */
2730 if (f->sym->attr.optional && f->sym->attr.value
2731 && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
2732 && !gfc_bt_struct (f->sym->ts.type)((f->sym->ts.type) == BT_DERIVED || (f->sym->ts.type
) == BT_UNION))
2733 {
2734 tree tmp;
2735 strcpy (&name[1], f->sym->name);
2736 name[0] = '.';
2737 tmp = build_decl (input_location,
2738 PARM_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)),
2739 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
2740
2741 optval_arglist = chainon (optval_arglist, tmp);
2742 DECL_CONTEXT (tmp)((contains_struct_check ((tmp), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2742, __FUNCTION__))->decl_minimal.context) = fndecl;
2743 DECL_ARTIFICIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2743, __FUNCTION__))->decl_common.artificial_flag) = 1;
2744 DECL_ARG_TYPE (tmp)((tree_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2744, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE];
2745 TREE_READONLY (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2745, __FUNCTION__))->base.readonly_flag) = 1;
2746 gfc_finish_decl (tmp);
2747
2748 /* The presence flag must be boolean. */
2749 gcc_assert (TREE_VALUE (optval_typelist) == boolean_type_node)((void)(!(((tree_check ((optval_typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2749, __FUNCTION__, (TREE_LIST)))->list.value) == global_trees
[TI_BOOLEAN_TYPE]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2749, __FUNCTION__), 0 : 0));
2750 optval_typelist = TREE_CHAIN (optval_typelist)((contains_struct_check ((optval_typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2750, __FUNCTION__))->common.chain);
2751 }
2752
2753 /* For non-constant length array arguments, make sure they use
2754 a different type node from TYPE_ARG_TYPES type. */
2755 if (f->sym->attr.dimension
2756 && type == TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2756, __FUNCTION__, (TREE_LIST)))->list.value)
2757 && TREE_CODE (type)((enum tree_code) (type)->base.code) == POINTER_TYPE
2758 && GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2758, __FUNCTION__))->type_common.lang_flag_2)
2759 && f->sym->as->type != AS_ASSUMED_SIZE
2760 && ! COMPLETE_TYPE_P (TREE_TYPE (type))(((tree_class_check ((((contains_struct_check ((type), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2760, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2760, __FUNCTION__))->type_common.size) != (tree) __null
))
2761 {
2762 if (f->sym->attr.flavor == FL_PROCEDURE)
2763 type = build_pointer_type (gfc_get_function_type (f->sym));
2764 else
2765 type = gfc_sym_type (f->sym);
2766 }
2767
2768 if (f->sym->attr.proc_pointer)
2769 type = build_pointer_type (type);
2770
2771 if (f->sym->attr.volatile_)
2772 type = build_qualified_type (type, TYPE_QUAL_VOLATILE);
2773
2774 /* Build the argument declaration. For C descriptors, we use a
2775 '_'-prefixed name for the parm_decl and inside the proc the
2776 sym->name. */
2777 tree parm_name;
2778 if (sym->attr.is_bind_c && is_CFI_desc (f->sym, NULL__null))
2779 {
2780 strcpy (&name[1], f->sym->name);
2781 name[0] = '_';
2782 parm_name = get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name));
2783 }
2784 else
2785 parm_name = gfc_sym_identifier (f->sym);
2786 parm = build_decl (input_location, PARM_DECL, parm_name, type);
2787
2788 if (f->sym->attr.volatile_)
2789 {
2790 TREE_THIS_VOLATILE (parm)((parm)->base.volatile_flag) = 1;
2791 TREE_SIDE_EFFECTS (parm)((non_type_check ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2791, __FUNCTION__))->base.side_effects_flag) = 1;
2792 }
2793
2794 /* Fill in arg stuff. */
2795 DECL_CONTEXT (parm)((contains_struct_check ((parm), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2795, __FUNCTION__))->decl_minimal.context) = fndecl;
2796 DECL_ARG_TYPE (parm)((tree_check ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2796, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2796, __FUNCTION__, (TREE_LIST)))->list.value);
2797 /* All implementation args except for VALUE are read-only. */
2798 if (!f->sym->attr.value)
2799 TREE_READONLY (parm)((non_type_check ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2799, __FUNCTION__))->base.readonly_flag) = 1;
2800 if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE)
2801 && (!f->sym->attr.proc_pointer
2802 && f->sym->attr.flavor != FL_PROCEDURE))
2803 DECL_BY_REFERENCE (parm)((tree_check3 ((parm), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2803, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL))
)->decl_common.decl_by_reference_flag) = 1;
2804 if (f->sym->attr.optional)
2805 {
2806 gfc_allocate_lang_decl (parm);
2807 GFC_DECL_OPTIONAL_ARGUMENT (parm)(((contains_struct_check ((parm), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2807, __FUNCTION__))->decl_common.lang_specific)->optional_arg
) = 1;
2808 }
2809
2810 gfc_finish_decl (parm);
2811 gfc_finish_decl_attrs (parm, &f->sym->attr);
2812
2813 f->sym->backend_decl = parm;
2814
2815 /* Coarrays which are descriptorless or assumed-shape pass with
2816 -fcoarray=lib the token and the offset as hidden arguments. */
2817 if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
2818 && ((f->sym->ts.type != BT_CLASS && f->sym->attr.codimension
2819 && !f->sym->attr.allocatable)
2820 || (f->sym->ts.type == BT_CLASS
2821 && CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.codimension
2822 && !CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.allocatable)))
2823 {
2824 tree caf_type;
2825 tree token;
2826 tree offset;
2827
2828 gcc_assert (f->sym->backend_decl != NULL_TREE((void)(!(f->sym->backend_decl != (tree) __null &&
!sym->attr.is_bind_c) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2829, __FUNCTION__), 0 : 0))
2829 && !sym->attr.is_bind_c)((void)(!(f->sym->backend_decl != (tree) __null &&
!sym->attr.is_bind_c) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2829, __FUNCTION__), 0 : 0));
2830 caf_type = f->sym->ts.type == BT_CLASS
2831 ? TREE_TYPE (CLASS_DATA (f->sym)->backend_decl)((contains_struct_check ((f->sym->ts.u.derived->components
->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2831, __FUNCTION__))->typed.type)
2832 : TREE_TYPE (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2832, __FUNCTION__))->typed.type);
2833
2834 token = build_decl (input_location, PARM_DECL,
2835 create_tmp_var_name ("caf_token"),
2836 build_qualified_type (pvoid_type_node,
2837 TYPE_QUAL_RESTRICT));
2838 if ((f->sym->ts.type != BT_CLASS
2839 && f->sym->as->type != AS_DEFERRED)
2840 || (f->sym->ts.type == BT_CLASS
2841 && CLASS_DATA (f->sym)f->sym->ts.u.derived->components->as->type != AS_DEFERRED))
2842 {
2843 gcc_assert (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2843, __FUNCTION__))->decl_common.lang_specific) == __null
|| ((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2844, __FUNCTION__))->decl_common.lang_specific)->token
== (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2844, __FUNCTION__), 0 : 0))
2844 || GFC_DECL_TOKEN (f->sym->backend_decl) == NULL_TREE)((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2843, __FUNCTION__))->decl_common.lang_specific) == __null
|| ((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2844, __FUNCTION__))->decl_common.lang_specific)->token
== (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2844, __FUNCTION__), 0 : 0));
2845 if (DECL_LANG_SPECIFIC (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2845, __FUNCTION__))->decl_common.lang_specific) == NULL__null)
2846 gfc_allocate_lang_decl (f->sym->backend_decl);
2847 GFC_DECL_TOKEN (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2847, __FUNCTION__))->decl_common.lang_specific)->token = token;
2848 }
2849 else
2850 {
2851 gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE)((void)(!((((tree_class_check ((caf_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2851, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token) == (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2851, __FUNCTION__), 0 : 0));
2852 GFC_TYPE_ARRAY_CAF_TOKEN (caf_type)(((tree_class_check ((caf_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2852, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token) = token;
2853 }
2854
2855 DECL_CONTEXT (token)((contains_struct_check ((token), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2855, __FUNCTION__))->decl_minimal.context) = fndecl;
2856 DECL_ARTIFICIAL (token)((contains_struct_check ((token), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2856, __FUNCTION__))->decl_common.artificial_flag) = 1;
2857 DECL_ARG_TYPE (token)((tree_check ((token), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2857, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2857, __FUNCTION__, (TREE_LIST)))->list.value);
2858 TREE_READONLY (token)((non_type_check ((token), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2858, __FUNCTION__))->base.readonly_flag) = 1;
2859 hidden_arglist = chainon (hidden_arglist, token);
2860 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2860, __FUNCTION__))->common.chain);
2861 gfc_finish_decl (token);
2862
2863 offset = build_decl (input_location, PARM_DECL,
2864 create_tmp_var_name ("caf_offset"),
2865 gfc_array_index_type);
2866
2867 if ((f->sym->ts.type != BT_CLASS
2868 && f->sym->as->type != AS_DEFERRED)
2869 || (f->sym->ts.type == BT_CLASS
2870 && CLASS_DATA (f->sym)f->sym->ts.u.derived->components->as->type != AS_DEFERRED))
2871 {
2872 gcc_assert (GFC_DECL_CAF_OFFSET (f->sym->backend_decl)((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2872, __FUNCTION__))->decl_common.lang_specific)->caf_offset
== (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2873, __FUNCTION__), 0 : 0))
2873 == NULL_TREE)((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2872, __FUNCTION__))->decl_common.lang_specific)->caf_offset
== (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2873, __FUNCTION__), 0 : 0));
2874 GFC_DECL_CAF_OFFSET (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2874, __FUNCTION__))->decl_common.lang_specific)->caf_offset = offset;
2875 }
2876 else
2877 {
2878 gcc_assert (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) == NULL_TREE)((void)(!((((tree_class_check ((caf_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2878, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_offset) == (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2878, __FUNCTION__), 0 : 0));
2879 GFC_TYPE_ARRAY_CAF_OFFSET (caf_type)(((tree_class_check ((caf_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2879, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_offset) = offset;
2880 }
2881 DECL_CONTEXT (offset)((contains_struct_check ((offset), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2881, __FUNCTION__))->decl_minimal.context) = fndecl;
2882 DECL_ARTIFICIAL (offset)((contains_struct_check ((offset), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2882, __FUNCTION__))->decl_common.artificial_flag) = 1;
2883 DECL_ARG_TYPE (offset)((tree_check ((offset), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2883, __FUNCTION__, (PARM_DECL)))->decl_common.initial) = TREE_VALUE (typelist)((tree_check ((typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2883, __FUNCTION__, (TREE_LIST)))->list.value);
2884 TREE_READONLY (offset)((non_type_check ((offset), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2884, __FUNCTION__))->base.readonly_flag) = 1;
2885 hidden_arglist = chainon (hidden_arglist, offset);
2886 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2886, __FUNCTION__))->common.chain);
2887 gfc_finish_decl (offset);
2888 }
2889
2890 arglist = chainon (arglist, parm);
2891 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2891, __FUNCTION__))->common.chain);
2892 }
2893
2894 /* Add hidden present status for optional+value arguments. */
2895 arglist = chainon (arglist, optval_arglist);
2896
2897 /* Add the hidden string length parameters, unless the procedure
2898 is bind(C). */
2899 if (!sym->attr.is_bind_c)
2900 arglist = chainon (arglist, hidden_arglist);
2901
2902 gcc_assert (hidden_typelist == NULL_TREE((void)(!(hidden_typelist == (tree) __null || ((tree_check ((
hidden_typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2903, __FUNCTION__, (TREE_LIST)))->list.value) == global_trees
[TI_VOID_TYPE]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2903, __FUNCTION__), 0 : 0))
2903 || TREE_VALUE (hidden_typelist) == void_type_node)((void)(!(hidden_typelist == (tree) __null || ((tree_check ((
hidden_typelist), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2903, __FUNCTION__, (TREE_LIST)))->list.value) == global_trees
[TI_VOID_TYPE]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2903, __FUNCTION__), 0 : 0));
2904 DECL_ARGUMENTS (fndecl)((tree_check ((fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2904, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
) = arglist;
2905}
2906
2907/* Do the setup necessary before generating the body of a function. */
2908
2909static void
2910trans_function_start (gfc_symbol * sym)
2911{
2912 tree fndecl;
2913
2914 fndecl = sym->backend_decl;
2915
2916 /* Let GCC know the current scope is this function. */
2917 current_function_decl = fndecl;
2918
2919 /* Let the world know what we're about to do. */
2920 announce_function (fndecl);
2921
2922 if (DECL_FILE_SCOPE_P (fndecl)(! (((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2922, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2922, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL))
2923 {
2924 /* Create RTL for function declaration. */
2925 rest_of_decl_compilation (fndecl, 1, 0);
2926 }
2927
2928 /* Create RTL for function definition. */
2929 make_decl_rtl (fndecl);
2930
2931 allocate_struct_function (fndecl, false);
2932
2933 /* function.cc requires a push at the start of the function. */
2934 pushlevel ();
2935}
2936
2937/* Create thunks for alternate entry points. */
2938
2939static void
2940build_entry_thunks (gfc_namespace * ns, bool global)
2941{
2942 gfc_formal_arglist *formal;
2943 gfc_formal_arglist *thunk_formal;
2944 gfc_entry_list *el;
2945 gfc_symbol *thunk_sym;
2946 stmtblock_t body;
2947 tree thunk_fndecl;
2948 tree tmp;
2949 locus old_loc;
2950
2951 /* This should always be a toplevel function. */
2952 gcc_assert (current_function_decl == NULL_TREE)((void)(!(current_function_decl == (tree) __null) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2952, __FUNCTION__), 0 : 0));
2953
2954 gfc_save_backend_locus (&old_loc);
2955 for (el = ns->entries; el; el = el->next)
2956 {
2957 vec<tree, va_gc> *args = NULL__null;
2958 vec<tree, va_gc> *string_args = NULL__null;
2959
2960 thunk_sym = el->sym;
2961
2962 build_function_decl (thunk_sym, global);
2963 create_function_arglist (thunk_sym);
2964
2965 trans_function_start (thunk_sym);
2966
2967 thunk_fndecl = thunk_sym->backend_decl;
2968
2969 gfc_init_block (&body);
2970
2971 /* Pass extra parameter identifying this entry point. */
2972 tmp = build_int_cst (gfc_array_index_type, el->id);
2973 vec_safe_push (args, tmp);
2974
2975 if (thunk_sym->attr.function)
2976 {
2977 if (gfc_return_by_reference (ns->proc_name))
2978 {
2979 tree ref = DECL_ARGUMENTS (current_function_decl)((tree_check ((current_function_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2979, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
);
2980 vec_safe_push (args, ref);
2981 if (ns->proc_name->ts.type == BT_CHARACTER)
2982 vec_safe_push (args, DECL_CHAIN (ref)(((contains_struct_check (((contains_struct_check ((ref), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2982, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 2982, __FUNCTION__))->common.chain)));
2983 }
2984 }
2985
2986 for (formal = gfc_sym_get_dummy_args (ns->proc_name); formal;
2987 formal = formal->next)
2988 {
2989 /* Ignore alternate returns. */
2990 if (formal->sym == NULL__null)
2991 continue;
2992
2993 /* We don't have a clever way of identifying arguments, so resort to
2994 a brute-force search. */
2995 for (thunk_formal = gfc_sym_get_dummy_args (thunk_sym);
2996 thunk_formal;
2997 thunk_formal = thunk_formal->next)
2998 {
2999 if (thunk_formal->sym == formal->sym)
3000 break;
3001 }
3002
3003 if (thunk_formal)
3004 {
3005 /* Pass the argument. */
3006 DECL_ARTIFICIAL (thunk_formal->sym->backend_decl)((contains_struct_check ((thunk_formal->sym->backend_decl
), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3006, __FUNCTION__))->decl_common.artificial_flag) = 1;
3007 vec_safe_push (args, thunk_formal->sym->backend_decl);
3008 if (formal->sym->ts.type == BT_CHARACTER)
3009 {
3010 tmp = thunk_formal->sym->ts.u.cl->backend_decl;
3011 vec_safe_push (string_args, tmp);
3012 }
3013 }
3014 else
3015 {
3016 /* Pass NULL for a missing argument. */
3017 vec_safe_push (args, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
3018 if (formal->sym->ts.type == BT_CHARACTER)
3019 {
3020 tmp = build_int_cst (gfc_charlen_type_node, 0);
3021 vec_safe_push (string_args, tmp);
3022 }
3023 }
3024 }
3025
3026 /* Call the master function. */
3027 vec_safe_splice (args, string_args);
3028 tmp = ns->proc_name->backend_decl;
3029 tmp = build_call_expr_loc_vec (input_location, tmp, args);
3030 if (ns->proc_name->attr.mixed_entry_master)
3031 {
3032 tree union_decl, field;
3033 tree master_type = TREE_TYPE (ns->proc_name->backend_decl)((contains_struct_check ((ns->proc_name->backend_decl),
(TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3033, __FUNCTION__))->typed.type);
3034
3035 union_decl = build_decl (input_location,
3036 VAR_DECL, get_identifier ("__result")(__builtin_constant_p ("__result") ? get_identifier_with_length
(("__result"), strlen ("__result")) : get_identifier ("__result"
)),
3037 TREE_TYPE (master_type)((contains_struct_check ((master_type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3037, __FUNCTION__))->typed.type));
3038 DECL_ARTIFICIAL (union_decl)((contains_struct_check ((union_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3038, __FUNCTION__))->decl_common.artificial_flag) = 1;
3039 DECL_EXTERNAL (union_decl)((contains_struct_check ((union_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3039, __FUNCTION__))->decl_common.decl_flag_1) = 0;
3040 TREE_PUBLIC (union_decl)((union_decl)->base.public_flag) = 0;
3041 TREE_USED (union_decl)((union_decl)->base.used_flag) = 1;
3042 layout_decl (union_decl, 0);
3043 pushdecl (union_decl);
3044
3045 DECL_CONTEXT (union_decl)((contains_struct_check ((union_decl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3045, __FUNCTION__))->decl_minimal.context) = current_function_decl;
3046 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
3047 TREE_TYPE (union_decl)((contains_struct_check ((union_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3047, __FUNCTION__))->typed.type), union_decl, tmp);
3048 gfc_add_expr_to_block (&body, tmp);
3049
3050 for (field = TYPE_FIELDS (TREE_TYPE (union_decl))((tree_check3 ((((contains_struct_check ((union_decl), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3050, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3050, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values);
3051 field; field = DECL_CHAIN (field)(((contains_struct_check (((contains_struct_check ((field), (
TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3051, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3051, __FUNCTION__))->common.chain)))
3052 if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field))((const char *) (tree_check ((((contains_struct_check ((field
), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3052, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3052, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
),
3053 thunk_sym->result->name) == 0)
3054 break;
3055 gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3055, __FUNCTION__), 0 : 0));
3056 tmp = fold_build3_loc (input_location, COMPONENT_REF,
3057 TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3057, __FUNCTION__))->typed.type), union_decl, field,
3058 NULL_TREE(tree) __null);
3059 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
3060 TREE_TYPE (DECL_RESULT (current_function_decl))((contains_struct_check ((((tree_check ((current_function_decl
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3060, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3060, __FUNCTION__))->typed.type),
3061 DECL_RESULT (current_function_decl)((tree_check ((current_function_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3061, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
), tmp);
3062 tmp = build1_v (RETURN_EXPR, tmp)fold_build1_loc (input_location, RETURN_EXPR, global_trees[TI_VOID_TYPE
], tmp);
3063 }
3064 else if (TREE_TYPE (DECL_RESULT (current_function_decl))((contains_struct_check ((((tree_check ((current_function_decl
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3064, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3064, __FUNCTION__))->typed.type)
3065 != void_type_nodeglobal_trees[TI_VOID_TYPE])
3066 {
3067 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
3068 TREE_TYPE (DECL_RESULT (current_function_decl))((contains_struct_check ((((tree_check ((current_function_decl
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3068, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3068, __FUNCTION__))->typed.type),
3069 DECL_RESULT (current_function_decl)((tree_check ((current_function_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3069, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
), tmp);
3070 tmp = build1_v (RETURN_EXPR, tmp)fold_build1_loc (input_location, RETURN_EXPR, global_trees[TI_VOID_TYPE
], tmp);
3071 }
3072 gfc_add_expr_to_block (&body, tmp);
3073
3074 /* Finish off this function and send it for code generation. */
3075 DECL_SAVED_TREE (thunk_fndecl)((tree_check ((thunk_fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3075, __FUNCTION__, (FUNCTION_DECL)))->function_decl.saved_tree
) = gfc_finish_block (&body);
3076 tmp = getdecls ();
3077 poplevel (1, 1);
3078 BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl))((tree_check ((((contains_struct_check ((thunk_fndecl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3078, __FUNCTION__))->decl_common.initial)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3078, __FUNCTION__, (BLOCK)))->block.supercontext) = thunk_fndecl;
3079 DECL_SAVED_TREE (thunk_fndecl)((tree_check ((thunk_fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3079, __FUNCTION__, (FUNCTION_DECL)))->function_decl.saved_tree
)
3080 = fold_build3_loc (DECL_SOURCE_LOCATION (thunk_fndecl)((contains_struct_check ((thunk_fndecl), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3080, __FUNCTION__))->decl_minimal.locus), BIND_EXPR,
3081 void_type_nodeglobal_trees[TI_VOID_TYPE], tmp, DECL_SAVED_TREE (thunk_fndecl)((tree_check ((thunk_fndecl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3081, __FUNCTION__, (FUNCTION_DECL)))->function_decl.saved_tree
),
3082 DECL_INITIAL (thunk_fndecl)((contains_struct_check ((thunk_fndecl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3082, __FUNCTION__))->decl_common.initial));
3083
3084 /* Output the GENERIC tree. */
3085 dump_function (TDI_original, thunk_fndecl);
3086
3087 /* Store the end of the function, so that we get good line number
3088 info for the epilogue. */
3089 cfun(cfun + 0)->function_end_locus = input_location;
3090
3091 /* We're leaving the context of this function, so zap cfun.
3092 It's still in DECL_STRUCT_FUNCTION, and we'll restore it in
3093 tree_rest_of_compilation. */
3094 set_cfun (NULL__null);
3095
3096 current_function_decl = NULL_TREE(tree) __null;
3097
3098 cgraph_node::finalize_function (thunk_fndecl, true);
3099
3100 /* We share the symbols in the formal argument list with other entry
3101 points and the master function. Clear them so that they are
3102 recreated for each function. */
3103 for (formal = gfc_sym_get_dummy_args (thunk_sym); formal;
3104 formal = formal->next)
3105 if (formal->sym != NULL__null) /* Ignore alternate returns. */
3106 {
3107 formal->sym->backend_decl = NULL_TREE(tree) __null;
3108 if (formal->sym->ts.type == BT_CHARACTER)
3109 formal->sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
3110 }
3111
3112 if (thunk_sym->attr.function)
3113 {
3114 if (thunk_sym->ts.type == BT_CHARACTER)
3115 thunk_sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
3116 if (thunk_sym->result->ts.type == BT_CHARACTER)
3117 thunk_sym->result->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
3118 }
3119 }
3120
3121 gfc_restore_backend_locus (&old_loc);
3122}
3123
3124
3125/* Create a decl for a function, and create any thunks for alternate entry
3126 points. If global is true, generate the function in the global binding
3127 level, otherwise in the current binding level (which can be global). */
3128
3129void
3130gfc_create_function_decl (gfc_namespace * ns, bool global)
3131{
3132 /* Create a declaration for the master function. */
3133 build_function_decl (ns->proc_name, global);
3134
3135 /* Compile the entry thunks. */
3136 if (ns->entries)
3137 build_entry_thunks (ns, global);
3138
3139 /* Now create the read argument list. */
3140 create_function_arglist (ns->proc_name);
3141
3142 if (ns->omp_declare_simd)
3143 gfc_trans_omp_declare_simd (ns);
3144
3145 /* Handle 'declare variant' directives. The applicable directives might
3146 be declared in a parent namespace, so this needs to be called even if
3147 there are no local directives. */
3148 if (flag_openmpglobal_options.x_flag_openmp)
3149 gfc_trans_omp_declare_variant (ns);
3150}
3151
3152/* Return the decl used to hold the function return value. If
3153 parent_flag is set, the context is the parent_scope. */
3154
3155tree
3156gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag)
3157{
3158 tree decl;
3159 tree length;
3160 tree this_fake_result_decl;
3161 tree this_function_decl;
3162
3163 char name[GFC_MAX_SYMBOL_LEN63 + 10];
3164
3165 if (parent_flag)
3166 {
3167 this_fake_result_decl = parent_fake_result_decl;
3168 this_function_decl = DECL_CONTEXT (current_function_decl)((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3168, __FUNCTION__))->decl_minimal.context);
3169 }
3170 else
3171 {
3172 this_fake_result_decl = current_fake_result_decl;
3173 this_function_decl = current_function_decl;
3174 }
3175
3176 if (sym
3177 && sym->ns->proc_name->backend_decl == this_function_decl
3178 && sym->ns->proc_name->attr.entry_master
3179 && sym != sym->ns->proc_name)
3180 {
3181 tree t = NULL__null, var;
3182 if (this_fake_result_decl != NULL__null)
3183 for (t = TREE_CHAIN (this_fake_result_decl)((contains_struct_check ((this_fake_result_decl), (TS_COMMON)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3183, __FUNCTION__))->common.chain); t; t = TREE_CHAIN (t)((contains_struct_check ((t), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3183, __FUNCTION__))->common.chain))
3184 if (strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t))((const char *) (tree_check ((((tree_check ((t), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3184, __FUNCTION__, (TREE_LIST)))->list.purpose)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3184, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
), sym->name) == 0)
3185 break;
3186 if (t)
3187 return TREE_VALUE (t)((tree_check ((t), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3187, __FUNCTION__, (TREE_LIST)))->list.value);
3188 decl = gfc_get_fake_result_decl (sym->ns->proc_name, parent_flag);
3189
3190 if (parent_flag)
3191 this_fake_result_decl = parent_fake_result_decl;
3192 else
3193 this_fake_result_decl = current_fake_result_decl;
3194
3195 if (decl && sym->ns->proc_name->attr.mixed_entry_master)
3196 {
3197 tree field;
3198
3199 for (field = TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3199, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3199, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values);
3200 field; field = DECL_CHAIN (field)(((contains_struct_check (((contains_struct_check ((field), (
TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3200, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3200, __FUNCTION__))->common.chain)))
3201 if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field))((const char *) (tree_check ((((contains_struct_check ((field
), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3201, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3201, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
),
3202 sym->name) == 0)
3203 break;
3204
3205 gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3205, __FUNCTION__), 0 : 0));
3206 decl = fold_build3_loc (input_location, COMPONENT_REF,
3207 TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3207, __FUNCTION__))->typed.type), decl, field, NULL_TREE(tree) __null);
3208 }
3209
3210 var = create_tmp_var_raw (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3210, __FUNCTION__))->typed.type), sym->name);
3211 if (parent_flag)
3212 gfc_add_decl_to_parent_function (var);
3213 else
3214 gfc_add_decl_to_function (var);
3215
3216 SET_DECL_VALUE_EXPR (var, decl)(decl_value_expr_insert ((contains_struct_check ((var), (TS_DECL_WRTL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3216, __FUNCTION__)), decl));
3217 DECL_HAS_VALUE_EXPR_P (var)((tree_check3 ((var), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3217, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL))
) ->decl_common.decl_flag_2) = 1;
3218 GFC_DECL_RESULT (var)((contains_struct_check ((var), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3218, __FUNCTION__))->decl_common.lang_flag_5) = 1;
3219
3220 TREE_CHAIN (this_fake_result_decl)((contains_struct_check ((this_fake_result_decl), (TS_COMMON)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3220, __FUNCTION__))->common.chain)
3221 = tree_cons (get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name)), var,
3222 TREE_CHAIN (this_fake_result_decl)((contains_struct_check ((this_fake_result_decl), (TS_COMMON)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3222, __FUNCTION__))->common.chain));
3223 return var;
3224 }
3225
3226 if (this_fake_result_decl != NULL_TREE(tree) __null)
3227 return TREE_VALUE (this_fake_result_decl)((tree_check ((this_fake_result_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3227, __FUNCTION__, (TREE_LIST)))->list.value);
3228
3229 /* Only when gfc_get_fake_result_decl is called by gfc_trans_return,
3230 sym is NULL. */
3231 if (!sym)
3232 return NULL_TREE(tree) __null;
3233
3234 if (sym->ts.type == BT_CHARACTER)
3235 {
3236 if (sym->ts.u.cl->backend_decl == NULL_TREE(tree) __null)
3237 length = gfc_create_string_length (sym);
3238 else
3239 length = sym->ts.u.cl->backend_decl;
3240 if (VAR_P (length)(((enum tree_code) (length)->base.code) == VAR_DECL) && DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3240, __FUNCTION__))->decl_minimal.context) == NULL_TREE(tree) __null)
3241 gfc_add_decl_to_function (length);
3242 }
3243
3244 if (gfc_return_by_reference (sym))
3245 {
3246 decl = DECL_ARGUMENTS (this_function_decl)((tree_check ((this_function_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3246, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
);
3247
3248 if (sym->ns->proc_name->backend_decl == this_function_decl
3249 && sym->ns->proc_name->attr.entry_master)
3250 decl = DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3250, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3250, __FUNCTION__))->common.chain));
3251
3252 TREE_USED (decl)((decl)->base.used_flag) = 1;
3253 if (sym->as)
3254 decl = gfc_build_dummy_array_decl (sym, decl);
3255 }
3256 else
3257 {
3258 sprintf (name, "__result_%.20s",
3259 IDENTIFIER_POINTER (DECL_NAME (this_function_decl))((const char *) (tree_check ((((contains_struct_check ((this_function_decl
), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3259, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3259, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
));
3260
3261 if (!sym->attr.mixed_entry_master && sym->attr.function)
3262 decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl)((contains_struct_check ((this_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3262, __FUNCTION__))->decl_minimal.locus),
3263 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)),
3264 gfc_sym_type (sym));
3265 else
3266 decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl)((contains_struct_check ((this_function_decl), (TS_DECL_MINIMAL
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3266, __FUNCTION__))->decl_minimal.locus),
3267 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)),
3268 TREE_TYPE (TREE_TYPE (this_function_decl))((contains_struct_check ((((contains_struct_check ((this_function_decl
), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3268, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3268, __FUNCTION__))->typed.type));
3269 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3269, __FUNCTION__))->decl_common.artificial_flag) = 1;
3270 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3270, __FUNCTION__))->decl_common.decl_flag_1) = 0;
3271 TREE_PUBLIC (decl)((decl)->base.public_flag) = 0;
3272 TREE_USED (decl)((decl)->base.used_flag) = 1;
3273 GFC_DECL_RESULT (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3273, __FUNCTION__))->decl_common.lang_flag_5) = 1;
3274 TREE_ADDRESSABLE (decl)((decl)->base.addressable_flag) = 1;
3275
3276 layout_decl (decl, 0);
3277 gfc_finish_decl_attrs (decl, &sym->attr);
3278
3279 if (parent_flag)
3280 gfc_add_decl_to_parent_function (decl);
3281 else
3282 gfc_add_decl_to_function (decl);
3283 }
3284
3285 if (parent_flag)
3286 parent_fake_result_decl = build_tree_list (NULL__null, decl);
3287 else
3288 current_fake_result_decl = build_tree_list (NULL__null, decl);
3289
3290 if (sym->attr.assign)
3291 DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3291, __FUNCTION__))->decl_common.lang_specific) = DECL_LANG_SPECIFIC (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3291, __FUNCTION__))->decl_common.lang_specific);
3292
3293 return decl;
3294}
3295
3296
3297/* Builds a function decl. The remaining parameters are the types of the
3298 function arguments. Negative nargs indicates a varargs function. */
3299
3300static tree
3301build_library_function_decl_1 (tree name, const char *spec,
3302 tree rettype, int nargs, va_list p)
3303{
3304 vec<tree, va_gc> *arglist;
3305 tree fntype;
3306 tree fndecl;
3307 int n;
3308
3309 /* Library functions must be declared with global scope. */
3310 gcc_assert (current_function_decl == NULL_TREE)((void)(!(current_function_decl == (tree) __null) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3310, __FUNCTION__), 0 : 0));
3311
3312 /* Create a list of the argument types. */
3313 vec_alloc (arglist, abs (nargs));
3314 for (n = abs (nargs); n > 0; n--)
3315 {
3316 tree argtype = va_arg (p, tree)__builtin_va_arg(p, tree);
3317 arglist->quick_push (argtype);
3318 }
3319
3320 /* Build the function type and decl. */
3321 if (nargs >= 0)
3322 fntype = build_function_type_vec (rettype, arglist)build_function_type_array (rettype, vec_safe_length (arglist)
, vec_safe_address (arglist));
3323 else
3324 fntype = build_varargs_function_type_vec (rettype, arglist)build_varargs_function_type_array (rettype, vec_safe_length (
arglist), vec_safe_address (arglist));
3325 if (spec)
3326 {
3327 tree attr_args = build_tree_list (NULL_TREE(tree) __null,
3328 build_string (strlen (spec), spec));
3329 tree attrs = tree_cons (get_identifier ("fn spec")(__builtin_constant_p ("fn spec") ? get_identifier_with_length
(("fn spec"), strlen ("fn spec")) : get_identifier ("fn spec"
)),
3330 attr_args, TYPE_ATTRIBUTES (fntype)((tree_class_check ((fntype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3330, __FUNCTION__))->type_common.attributes));
3331 fntype = build_type_attribute_variant (fntype, attrs);
3332 }
3333 fndecl = build_decl (input_location,
3334 FUNCTION_DECL, name, fntype);
3335
3336 /* Mark this decl as external. */
3337 DECL_EXTERNAL (fndecl)((contains_struct_check ((fndecl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3337, __FUNCTION__))->decl_common.decl_flag_1) = 1;
3338 TREE_PUBLIC (fndecl)((fndecl)->base.public_flag) = 1;
3339
3340 pushdecl (fndecl);
3341
3342 rest_of_decl_compilation (fndecl, 1, 0);
3343
3344 return fndecl;
3345}
3346
3347/* Builds a function decl. The remaining parameters are the types of the
3348 function arguments. Negative nargs indicates a varargs function. */
3349
3350tree
3351gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
3352{
3353 tree ret;
3354 va_list args;
3355 va_start (args, nargs)__builtin_va_start(args, nargs);
3356 ret = build_library_function_decl_1 (name, NULL__null, rettype, nargs, args);
3357 va_end (args)__builtin_va_end(args);
3358 return ret;
3359}
3360
3361/* Builds a function decl. The remaining parameters are the types of the
3362 function arguments. Negative nargs indicates a varargs function.
3363 The SPEC parameter specifies the function argument and return type
3364 specification according to the fnspec function type attribute. */
3365
3366tree
3367gfc_build_library_function_decl_with_spec (tree name, const char *spec,
3368 tree rettype, int nargs, ...)
3369{
3370 tree ret;
3371 va_list args;
3372 va_start (args, nargs)__builtin_va_start(args, nargs);
3373 if (flag_checkingglobal_options.x_flag_checking)
3374 {
3375 attr_fnspec fnspec (spec, strlen (spec));
3376 fnspec.verify ();
3377 }
3378 ret = build_library_function_decl_1 (name, spec, rettype, nargs, args);
3379 va_end (args)__builtin_va_end(args);
3380 return ret;
3381}
3382
3383static void
3384gfc_build_intrinsic_function_decls (void)
3385{
3386 tree gfc_int4_type_node = gfc_get_int_type (4);
3387 tree gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node);
3388 tree gfc_int8_type_node = gfc_get_int_type (8);
3389 tree gfc_pint8_type_node = build_pointer_type (gfc_int8_type_node);
3390 tree gfc_int16_type_node = gfc_get_int_type (16);
3391 tree gfc_logical4_type_node = gfc_get_logical_type (4);
3392 tree pchar1_type_node = gfc_get_pchar_type (1);
3393 tree pchar4_type_node = gfc_get_pchar_type (4);
3394
3395 /* String functions. */
3396 gfor_fndecl_compare_string = gfc_build_library_function_decl_with_spec (
3397 get_identifier (PREFIX("compare_string"))(__builtin_constant_p ("_gfortran_" "compare_string") ? get_identifier_with_length
(("_gfortran_" "compare_string"), strlen ("_gfortran_" "compare_string"
)) : get_identifier ("_gfortran_" "compare_string")), ". . R . R ",
3398 integer_type_nodeinteger_types[itk_int], 4, gfc_charlen_type_node, pchar1_type_node,
3399 gfc_charlen_type_node, pchar1_type_node);
3400 DECL_PURE_P (gfor_fndecl_compare_string)((tree_check ((gfor_fndecl_compare_string), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3400, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3401 TREE_NOTHROW (gfor_fndecl_compare_string)((gfor_fndecl_compare_string)->base.nothrow_flag) = 1;
3402
3403 gfor_fndecl_concat_string = gfc_build_library_function_decl_with_spec (
3404 get_identifier (PREFIX("concat_string"))(__builtin_constant_p ("_gfortran_" "concat_string") ? get_identifier_with_length
(("_gfortran_" "concat_string"), strlen ("_gfortran_" "concat_string"
)) : get_identifier ("_gfortran_" "concat_string")), ". . W . R . R ",
3405 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, gfc_charlen_type_node, pchar1_type_node,
3406 gfc_charlen_type_node, pchar1_type_node,
3407 gfc_charlen_type_node, pchar1_type_node);
3408 TREE_NOTHROW (gfor_fndecl_concat_string)((gfor_fndecl_concat_string)->base.nothrow_flag) = 1;
3409
3410 gfor_fndecl_string_len_trim = gfc_build_library_function_decl_with_spec (
3411 get_identifier (PREFIX("string_len_trim"))(__builtin_constant_p ("_gfortran_" "string_len_trim") ? get_identifier_with_length
(("_gfortran_" "string_len_trim"), strlen ("_gfortran_" "string_len_trim"
)) : get_identifier ("_gfortran_" "string_len_trim")), ". . R ",
3412 gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar1_type_node);
3413 DECL_PURE_P (gfor_fndecl_string_len_trim)((tree_check ((gfor_fndecl_string_len_trim), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3413, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3414 TREE_NOTHROW (gfor_fndecl_string_len_trim)((gfor_fndecl_string_len_trim)->base.nothrow_flag) = 1;
3415
3416 gfor_fndecl_string_index = gfc_build_library_function_decl_with_spec (
3417 get_identifier (PREFIX("string_index"))(__builtin_constant_p ("_gfortran_" "string_index") ? get_identifier_with_length
(("_gfortran_" "string_index"), strlen ("_gfortran_" "string_index"
)) : get_identifier ("_gfortran_" "string_index")), ". . R . R . ",
3418 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
3419 gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
3420 DECL_PURE_P (gfor_fndecl_string_index)((tree_check ((gfor_fndecl_string_index), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3420, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3421 TREE_NOTHROW (gfor_fndecl_string_index)((gfor_fndecl_string_index)->base.nothrow_flag) = 1;
3422
3423 gfor_fndecl_string_scan = gfc_build_library_function_decl_with_spec (
3424 get_identifier (PREFIX("string_scan"))(__builtin_constant_p ("_gfortran_" "string_scan") ? get_identifier_with_length
(("_gfortran_" "string_scan"), strlen ("_gfortran_" "string_scan"
)) : get_identifier ("_gfortran_" "string_scan")), ". . R . R . ",
3425 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
3426 gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
3427 DECL_PURE_P (gfor_fndecl_string_scan)((tree_check ((gfor_fndecl_string_scan), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3427, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3428 TREE_NOTHROW (gfor_fndecl_string_scan)((gfor_fndecl_string_scan)->base.nothrow_flag) = 1;
3429
3430 gfor_fndecl_string_verify = gfc_build_library_function_decl_with_spec (
3431 get_identifier (PREFIX("string_verify"))(__builtin_constant_p ("_gfortran_" "string_verify") ? get_identifier_with_length
(("_gfortran_" "string_verify"), strlen ("_gfortran_" "string_verify"
)) : get_identifier ("_gfortran_" "string_verify")), ". . R . R . ",
3432 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
3433 gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
3434 DECL_PURE_P (gfor_fndecl_string_verify)((tree_check ((gfor_fndecl_string_verify), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3434, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3435 TREE_NOTHROW (gfor_fndecl_string_verify)((gfor_fndecl_string_verify)->base.nothrow_flag) = 1;
3436
3437 gfor_fndecl_string_trim = gfc_build_library_function_decl_with_spec (
3438 get_identifier (PREFIX("string_trim"))(__builtin_constant_p ("_gfortran_" "string_trim") ? get_identifier_with_length
(("_gfortran_" "string_trim"), strlen ("_gfortran_" "string_trim"
)) : get_identifier ("_gfortran_" "string_trim")), ". W w . R ",
3439 void_type_nodeglobal_trees[TI_VOID_TYPE], 4, build_pointer_type (gfc_charlen_type_node),
3440 build_pointer_type (pchar1_type_node), gfc_charlen_type_node,
3441 pchar1_type_node);
3442
3443 gfor_fndecl_string_minmax = gfc_build_library_function_decl_with_spec (
3444 get_identifier (PREFIX("string_minmax"))(__builtin_constant_p ("_gfortran_" "string_minmax") ? get_identifier_with_length
(("_gfortran_" "string_minmax"), strlen ("_gfortran_" "string_minmax"
)) : get_identifier ("_gfortran_" "string_minmax")), ". W w . R ",
3445 void_type_nodeglobal_trees[TI_VOID_TYPE], -4, build_pointer_type (gfc_charlen_type_node),
3446 build_pointer_type (pchar1_type_node), integer_type_nodeinteger_types[itk_int],
3447 integer_type_nodeinteger_types[itk_int]);
3448
3449 gfor_fndecl_adjustl = gfc_build_library_function_decl_with_spec (
3450 get_identifier (PREFIX("adjustl"))(__builtin_constant_p ("_gfortran_" "adjustl") ? get_identifier_with_length
(("_gfortran_" "adjustl"), strlen ("_gfortran_" "adjustl")) :
get_identifier ("_gfortran_" "adjustl")), ". W . R ",
3451 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar1_type_node, gfc_charlen_type_node,
3452 pchar1_type_node);
3453 TREE_NOTHROW (gfor_fndecl_adjustl)((gfor_fndecl_adjustl)->base.nothrow_flag) = 1;
3454
3455 gfor_fndecl_adjustr = gfc_build_library_function_decl_with_spec (
3456 get_identifier (PREFIX("adjustr"))(__builtin_constant_p ("_gfortran_" "adjustr") ? get_identifier_with_length
(("_gfortran_" "adjustr"), strlen ("_gfortran_" "adjustr")) :
get_identifier ("_gfortran_" "adjustr")), ". W . R ",
3457 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar1_type_node, gfc_charlen_type_node,
3458 pchar1_type_node);
3459 TREE_NOTHROW (gfor_fndecl_adjustr)((gfor_fndecl_adjustr)->base.nothrow_flag) = 1;
3460
3461 gfor_fndecl_select_string = gfc_build_library_function_decl_with_spec (
3462 get_identifier (PREFIX("select_string"))(__builtin_constant_p ("_gfortran_" "select_string") ? get_identifier_with_length
(("_gfortran_" "select_string"), strlen ("_gfortran_" "select_string"
)) : get_identifier ("_gfortran_" "select_string")), ". R . R . ",
3463 integer_type_nodeinteger_types[itk_int], 4, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3464 pchar1_type_node, gfc_charlen_type_node);
3465 DECL_PURE_P (gfor_fndecl_select_string)((tree_check ((gfor_fndecl_select_string), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3465, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3466 TREE_NOTHROW (gfor_fndecl_select_string)((gfor_fndecl_select_string)->base.nothrow_flag) = 1;
3467
3468 gfor_fndecl_compare_string_char4 = gfc_build_library_function_decl_with_spec (
3469 get_identifier (PREFIX("compare_string_char4"))(__builtin_constant_p ("_gfortran_" "compare_string_char4") ?
get_identifier_with_length (("_gfortran_" "compare_string_char4"
), strlen ("_gfortran_" "compare_string_char4")) : get_identifier
("_gfortran_" "compare_string_char4")), ". . R . R ",
3470 integer_type_nodeinteger_types[itk_int], 4, gfc_charlen_type_node, pchar4_type_node,
3471 gfc_charlen_type_node, pchar4_type_node);
3472 DECL_PURE_P (gfor_fndecl_compare_string_char4)((tree_check ((gfor_fndecl_compare_string_char4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3472, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3473 TREE_NOTHROW (gfor_fndecl_compare_string_char4)((gfor_fndecl_compare_string_char4)->base.nothrow_flag) = 1;
3474
3475 gfor_fndecl_concat_string_char4 = gfc_build_library_function_decl_with_spec (
3476 get_identifier (PREFIX("concat_string_char4"))(__builtin_constant_p ("_gfortran_" "concat_string_char4") ? get_identifier_with_length
(("_gfortran_" "concat_string_char4"), strlen ("_gfortran_" "concat_string_char4"
)) : get_identifier ("_gfortran_" "concat_string_char4")), ". . W . R . R ",
3477 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, gfc_charlen_type_node, pchar4_type_node,
3478 gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node,
3479 pchar4_type_node);
3480 TREE_NOTHROW (gfor_fndecl_concat_string_char4)((gfor_fndecl_concat_string_char4)->base.nothrow_flag) = 1;
3481
3482 gfor_fndecl_string_len_trim_char4 = gfc_build_library_function_decl_with_spec (
3483 get_identifier (PREFIX("string_len_trim_char4"))(__builtin_constant_p ("_gfortran_" "string_len_trim_char4") ?
get_identifier_with_length (("_gfortran_" "string_len_trim_char4"
), strlen ("_gfortran_" "string_len_trim_char4")) : get_identifier
("_gfortran_" "string_len_trim_char4")), ". . R ",
3484 gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar4_type_node);
3485 DECL_PURE_P (gfor_fndecl_string_len_trim_char4)((tree_check ((gfor_fndecl_string_len_trim_char4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3485, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3486 TREE_NOTHROW (gfor_fndecl_string_len_trim_char4)((gfor_fndecl_string_len_trim_char4)->base.nothrow_flag) = 1;
3487
3488 gfor_fndecl_string_index_char4 = gfc_build_library_function_decl_with_spec (
3489 get_identifier (PREFIX("string_index_char4"))(__builtin_constant_p ("_gfortran_" "string_index_char4") ? get_identifier_with_length
(("_gfortran_" "string_index_char4"), strlen ("_gfortran_" "string_index_char4"
)) : get_identifier ("_gfortran_" "string_index_char4")), ". . R . R . ",
3490 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
3491 gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
3492 DECL_PURE_P (gfor_fndecl_string_index_char4)((tree_check ((gfor_fndecl_string_index_char4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3492, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3493 TREE_NOTHROW (gfor_fndecl_string_index_char4)((gfor_fndecl_string_index_char4)->base.nothrow_flag) = 1;
3494
3495 gfor_fndecl_string_scan_char4 = gfc_build_library_function_decl_with_spec (
3496 get_identifier (PREFIX("string_scan_char4"))(__builtin_constant_p ("_gfortran_" "string_scan_char4") ? get_identifier_with_length
(("_gfortran_" "string_scan_char4"), strlen ("_gfortran_" "string_scan_char4"
)) : get_identifier ("_gfortran_" "string_scan_char4")), ". . R . R . ",
3497 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
3498 gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
3499 DECL_PURE_P (gfor_fndecl_string_scan_char4)((tree_check ((gfor_fndecl_string_scan_char4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3499, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3500 TREE_NOTHROW (gfor_fndecl_string_scan_char4)((gfor_fndecl_string_scan_char4)->base.nothrow_flag) = 1;
3501
3502 gfor_fndecl_string_verify_char4 = gfc_build_library_function_decl_with_spec (
3503 get_identifier (PREFIX("string_verify_char4"))(__builtin_constant_p ("_gfortran_" "string_verify_char4") ? get_identifier_with_length
(("_gfortran_" "string_verify_char4"), strlen ("_gfortran_" "string_verify_char4"
)) : get_identifier ("_gfortran_" "string_verify_char4")), ". . R . R . ",
3504 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
3505 gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
3506 DECL_PURE_P (gfor_fndecl_string_verify_char4)((tree_check ((gfor_fndecl_string_verify_char4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3506, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3507 TREE_NOTHROW (gfor_fndecl_string_verify_char4)((gfor_fndecl_string_verify_char4)->base.nothrow_flag) = 1;
3508
3509 gfor_fndecl_string_trim_char4 = gfc_build_library_function_decl_with_spec (
3510 get_identifier (PREFIX("string_trim_char4"))(__builtin_constant_p ("_gfortran_" "string_trim_char4") ? get_identifier_with_length
(("_gfortran_" "string_trim_char4"), strlen ("_gfortran_" "string_trim_char4"
)) : get_identifier ("_gfortran_" "string_trim_char4")), ". W w . R ",
3511 void_type_nodeglobal_trees[TI_VOID_TYPE], 4, build_pointer_type (gfc_charlen_type_node),
3512 build_pointer_type (pchar4_type_node), gfc_charlen_type_node,
3513 pchar4_type_node);
3514
3515 gfor_fndecl_string_minmax_char4 = gfc_build_library_function_decl_with_spec (
3516 get_identifier (PREFIX("string_minmax_char4"))(__builtin_constant_p ("_gfortran_" "string_minmax_char4") ? get_identifier_with_length
(("_gfortran_" "string_minmax_char4"), strlen ("_gfortran_" "string_minmax_char4"
)) : get_identifier ("_gfortran_" "string_minmax_char4")), ". W w . R ",
3517 void_type_nodeglobal_trees[TI_VOID_TYPE], -4, build_pointer_type (gfc_charlen_type_node),
3518 build_pointer_type (pchar4_type_node), integer_type_nodeinteger_types[itk_int],
3519 integer_type_nodeinteger_types[itk_int]);
3520
3521 gfor_fndecl_adjustl_char4 = gfc_build_library_function_decl_with_spec (
3522 get_identifier (PREFIX("adjustl_char4"))(__builtin_constant_p ("_gfortran_" "adjustl_char4") ? get_identifier_with_length
(("_gfortran_" "adjustl_char4"), strlen ("_gfortran_" "adjustl_char4"
)) : get_identifier ("_gfortran_" "adjustl_char4")), ". W . R ",
3523 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar4_type_node, gfc_charlen_type_node,
3524 pchar4_type_node);
3525 TREE_NOTHROW (gfor_fndecl_adjustl_char4)((gfor_fndecl_adjustl_char4)->base.nothrow_flag) = 1;
3526
3527 gfor_fndecl_adjustr_char4 = gfc_build_library_function_decl_with_spec (
3528 get_identifier (PREFIX("adjustr_char4"))(__builtin_constant_p ("_gfortran_" "adjustr_char4") ? get_identifier_with_length
(("_gfortran_" "adjustr_char4"), strlen ("_gfortran_" "adjustr_char4"
)) : get_identifier ("_gfortran_" "adjustr_char4")), ". W . R ",
3529 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar4_type_node, gfc_charlen_type_node,
3530 pchar4_type_node);
3531 TREE_NOTHROW (gfor_fndecl_adjustr_char4)((gfor_fndecl_adjustr_char4)->base.nothrow_flag) = 1;
3532
3533 gfor_fndecl_select_string_char4 = gfc_build_library_function_decl_with_spec (
3534 get_identifier (PREFIX("select_string_char4"))(__builtin_constant_p ("_gfortran_" "select_string_char4") ? get_identifier_with_length
(("_gfortran_" "select_string_char4"), strlen ("_gfortran_" "select_string_char4"
)) : get_identifier ("_gfortran_" "select_string_char4")), ". R . R . ",
3535 integer_type_nodeinteger_types[itk_int], 4, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3536 pvoid_type_node, gfc_charlen_type_node);
3537 DECL_PURE_P (gfor_fndecl_select_string_char4)((tree_check ((gfor_fndecl_select_string_char4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3537, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3538 TREE_NOTHROW (gfor_fndecl_select_string_char4)((gfor_fndecl_select_string_char4)->base.nothrow_flag) = 1;
3539
3540
3541 /* Conversion between character kinds. */
3542
3543 gfor_fndecl_convert_char1_to_char4 = gfc_build_library_function_decl_with_spec (
3544 get_identifier (PREFIX("convert_char1_to_char4"))(__builtin_constant_p ("_gfortran_" "convert_char1_to_char4")
? get_identifier_with_length (("_gfortran_" "convert_char1_to_char4"
), strlen ("_gfortran_" "convert_char1_to_char4")) : get_identifier
("_gfortran_" "convert_char1_to_char4")), ". w . R ",
3545 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, build_pointer_type (pchar4_type_node),
3546 gfc_charlen_type_node, pchar1_type_node);
3547
3548 gfor_fndecl_convert_char4_to_char1 = gfc_build_library_function_decl_with_spec (
3549 get_identifier (PREFIX("convert_char4_to_char1"))(__builtin_constant_p ("_gfortran_" "convert_char4_to_char1")
? get_identifier_with_length (("_gfortran_" "convert_char4_to_char1"
), strlen ("_gfortran_" "convert_char4_to_char1")) : get_identifier
("_gfortran_" "convert_char4_to_char1")), ". w . R ",
3550 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, build_pointer_type (pchar1_type_node),
3551 gfc_charlen_type_node, pchar4_type_node);
3552
3553 /* Misc. functions. */
3554
3555 gfor_fndecl_ttynam = gfc_build_library_function_decl_with_spec (
3556 get_identifier (PREFIX("ttynam"))(__builtin_constant_p ("_gfortran_" "ttynam") ? get_identifier_with_length
(("_gfortran_" "ttynam"), strlen ("_gfortran_" "ttynam")) : get_identifier
("_gfortran_" "ttynam")), ". W . . ",
3557 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, gfc_charlen_type_node,
3558 integer_type_nodeinteger_types[itk_int]);
3559
3560 gfor_fndecl_fdate = gfc_build_library_function_decl_with_spec (
3561 get_identifier (PREFIX("fdate"))(__builtin_constant_p ("_gfortran_" "fdate") ? get_identifier_with_length
(("_gfortran_" "fdate"), strlen ("_gfortran_" "fdate")) : get_identifier
("_gfortran_" "fdate")), ". W . ",
3562 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, gfc_charlen_type_node);
3563
3564 gfor_fndecl_ctime = gfc_build_library_function_decl_with_spec (
3565 get_identifier (PREFIX("ctime"))(__builtin_constant_p ("_gfortran_" "ctime") ? get_identifier_with_length
(("_gfortran_" "ctime"), strlen ("_gfortran_" "ctime")) : get_identifier
("_gfortran_" "ctime")), ". W . . ",
3566 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, gfc_charlen_type_node,
3567 gfc_int8_type_node);
3568
3569 gfor_fndecl_random_init = gfc_build_library_function_decl (
3570 get_identifier (PREFIX("random_init"))(__builtin_constant_p ("_gfortran_" "random_init") ? get_identifier_with_length
(("_gfortran_" "random_init"), strlen ("_gfortran_" "random_init"
)) : get_identifier ("_gfortran_" "random_init")),
3571 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, gfc_logical4_type_node, gfc_logical4_type_node,
3572 gfc_int4_type_node);
3573
3574 // gfor_fndecl_caf_rand_init is defined in the lib-coarray section below.
3575
3576 gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec (
3577 get_identifier (PREFIX("selected_char_kind"))(__builtin_constant_p ("_gfortran_" "selected_char_kind") ? get_identifier_with_length
(("_gfortran_" "selected_char_kind"), strlen ("_gfortran_" "selected_char_kind"
)) : get_identifier ("_gfortran_" "selected_char_kind")), ". . R ",
3578 gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node);
3579 DECL_PURE_P (gfor_fndecl_sc_kind)((tree_check ((gfor_fndecl_sc_kind), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3579, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3580 TREE_NOTHROW (gfor_fndecl_sc_kind)((gfor_fndecl_sc_kind)->base.nothrow_flag) = 1;
3581
3582 gfor_fndecl_si_kind = gfc_build_library_function_decl_with_spec (
3583 get_identifier (PREFIX("selected_int_kind"))(__builtin_constant_p ("_gfortran_" "selected_int_kind") ? get_identifier_with_length
(("_gfortran_" "selected_int_kind"), strlen ("_gfortran_" "selected_int_kind"
)) : get_identifier ("_gfortran_" "selected_int_kind")), ". R ",
3584 gfc_int4_type_node, 1, pvoid_type_node);
3585 DECL_PURE_P (gfor_fndecl_si_kind)((tree_check ((gfor_fndecl_si_kind), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3585, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3586 TREE_NOTHROW (gfor_fndecl_si_kind)((gfor_fndecl_si_kind)->base.nothrow_flag) = 1;
3587
3588 gfor_fndecl_sr_kind = gfc_build_library_function_decl_with_spec (
3589 get_identifier (PREFIX("selected_real_kind2008"))(__builtin_constant_p ("_gfortran_" "selected_real_kind2008")
? get_identifier_with_length (("_gfortran_" "selected_real_kind2008"
), strlen ("_gfortran_" "selected_real_kind2008")) : get_identifier
("_gfortran_" "selected_real_kind2008")), ". R R ",
3590 gfc_int4_type_node, 3, pvoid_type_node, pvoid_type_node,
3591 pvoid_type_node);
3592 DECL_PURE_P (gfor_fndecl_sr_kind)((tree_check ((gfor_fndecl_sr_kind), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3592, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3593 TREE_NOTHROW (gfor_fndecl_sr_kind)((gfor_fndecl_sr_kind)->base.nothrow_flag) = 1;
3594
3595 gfor_fndecl_system_clock4 = gfc_build_library_function_decl (
3596 get_identifier (PREFIX("system_clock_4"))(__builtin_constant_p ("_gfortran_" "system_clock_4") ? get_identifier_with_length
(("_gfortran_" "system_clock_4"), strlen ("_gfortran_" "system_clock_4"
)) : get_identifier ("_gfortran_" "system_clock_4")),
3597 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, gfc_pint4_type_node, gfc_pint4_type_node,
3598 gfc_pint4_type_node);
3599
3600 gfor_fndecl_system_clock8 = gfc_build_library_function_decl (
3601 get_identifier (PREFIX("system_clock_8"))(__builtin_constant_p ("_gfortran_" "system_clock_8") ? get_identifier_with_length
(("_gfortran_" "system_clock_8"), strlen ("_gfortran_" "system_clock_8"
)) : get_identifier ("_gfortran_" "system_clock_8")),
3602 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, gfc_pint8_type_node, gfc_pint8_type_node,
3603 gfc_pint8_type_node);
3604
3605 /* Power functions. */
3606 {
3607 tree ctype, rtype, itype, jtype;
3608 int rkind, ikind, jkind;
3609#define NIKINDS 3
3610#define NRKINDS 4
3611 static int ikinds[NIKINDS] = {4, 8, 16};
3612 static int rkinds[NRKINDS] = {4, 8, 10, 16};
3613 char name[PREFIX_LEN10 + 12]; /* _gfortran_pow_?n_?n */
3614
3615 for (ikind=0; ikind < NIKINDS; ikind++)
3616 {
3617 itype = gfc_get_int_type (ikinds[ikind]);
3618
3619 for (jkind=0; jkind < NIKINDS; jkind++)
3620 {
3621 jtype = gfc_get_int_type (ikinds[jkind]);
3622 if (itype && jtype)
3623 {
3624 sprintf (name, PREFIX("pow_i%d_i%d")"_gfortran_" "pow_i%d_i%d", ikinds[ikind],
3625 ikinds[jkind]);
3626 gfor_fndecl_math_powi[jkind][ikind].integer =
3627 gfc_build_library_function_decl (get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)),
3628 jtype, 2, jtype, itype);
3629 TREE_READONLY (gfor_fndecl_math_powi[jkind][ikind].integer)((non_type_check ((gfor_fndecl_math_powi[jkind][ikind].integer
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3629, __FUNCTION__))->base.readonly_flag) = 1;
3630 TREE_NOTHROW (gfor_fndecl_math_powi[jkind][ikind].integer)((gfor_fndecl_math_powi[jkind][ikind].integer)->base.nothrow_flag
) = 1;
3631 }
3632 }
3633
3634 for (rkind = 0; rkind < NRKINDS; rkind ++)
3635 {
3636 rtype = gfc_get_real_type (rkinds[rkind]);
3637 if (rtype && itype)
3638 {
3639 sprintf (name, PREFIX("pow_r%d_i%d")"_gfortran_" "pow_r%d_i%d",
3640 gfc_type_abi_kind (BT_REAL, rkinds[rkind]),
3641 ikinds[ikind]);
3642 gfor_fndecl_math_powi[rkind][ikind].real =
3643 gfc_build_library_function_decl (get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)),
3644 rtype, 2, rtype, itype);
3645 TREE_READONLY (gfor_fndecl_math_powi[rkind][ikind].real)((non_type_check ((gfor_fndecl_math_powi[rkind][ikind].real),
"/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3645, __FUNCTION__))->base.readonly_flag) = 1;
3646 TREE_NOTHROW (gfor_fndecl_math_powi[rkind][ikind].real)((gfor_fndecl_math_powi[rkind][ikind].real)->base.nothrow_flag
) = 1;
3647 }
3648
3649 ctype = gfc_get_complex_type (rkinds[rkind]);
3650 if (ctype && itype)
3651 {
3652 sprintf (name, PREFIX("pow_c%d_i%d")"_gfortran_" "pow_c%d_i%d",
3653 gfc_type_abi_kind (BT_REAL, rkinds[rkind]),
3654 ikinds[ikind]);
3655 gfor_fndecl_math_powi[rkind][ikind].cmplx =
3656 gfc_build_library_function_decl (get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name)),
3657 ctype, 2,ctype, itype);
3658 TREE_READONLY (gfor_fndecl_math_powi[rkind][ikind].cmplx)((non_type_check ((gfor_fndecl_math_powi[rkind][ikind].cmplx)
, "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3658, __FUNCTION__))->base.readonly_flag) = 1;
3659 TREE_NOTHROW (gfor_fndecl_math_powi[rkind][ikind].cmplx)((gfor_fndecl_math_powi[rkind][ikind].cmplx)->base.nothrow_flag
) = 1;
3660 }
3661 }
3662 }
3663#undef NIKINDS
3664#undef NRKINDS
3665 }
3666
3667 gfor_fndecl_math_ishftc4 = gfc_build_library_function_decl (
3668 get_identifier (PREFIX("ishftc4"))(__builtin_constant_p ("_gfortran_" "ishftc4") ? get_identifier_with_length
(("_gfortran_" "ishftc4"), strlen ("_gfortran_" "ishftc4")) :
get_identifier ("_gfortran_" "ishftc4")),
3669 gfc_int4_type_node, 3, gfc_int4_type_node, gfc_int4_type_node,
3670 gfc_int4_type_node);
3671 TREE_READONLY (gfor_fndecl_math_ishftc4)((non_type_check ((gfor_fndecl_math_ishftc4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3671, __FUNCTION__))->base.readonly_flag) = 1;
3672 TREE_NOTHROW (gfor_fndecl_math_ishftc4)((gfor_fndecl_math_ishftc4)->base.nothrow_flag) = 1;
3673
3674 gfor_fndecl_math_ishftc8 = gfc_build_library_function_decl (
3675 get_identifier (PREFIX("ishftc8"))(__builtin_constant_p ("_gfortran_" "ishftc8") ? get_identifier_with_length
(("_gfortran_" "ishftc8"), strlen ("_gfortran_" "ishftc8")) :
get_identifier ("_gfortran_" "ishftc8")),
3676 gfc_int8_type_node, 3, gfc_int8_type_node, gfc_int4_type_node,
3677 gfc_int4_type_node);
3678 TREE_READONLY (gfor_fndecl_math_ishftc8)((non_type_check ((gfor_fndecl_math_ishftc8), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3678, __FUNCTION__))->base.readonly_flag) = 1;
3679 TREE_NOTHROW (gfor_fndecl_math_ishftc8)((gfor_fndecl_math_ishftc8)->base.nothrow_flag) = 1;
3680
3681 if (gfc_int16_type_node)
3682 {
3683 gfor_fndecl_math_ishftc16 = gfc_build_library_function_decl (
3684 get_identifier (PREFIX("ishftc16"))(__builtin_constant_p ("_gfortran_" "ishftc16") ? get_identifier_with_length
(("_gfortran_" "ishftc16"), strlen ("_gfortran_" "ishftc16")
) : get_identifier ("_gfortran_" "ishftc16")),
3685 gfc_int16_type_node, 3, gfc_int16_type_node, gfc_int4_type_node,
3686 gfc_int4_type_node);
3687 TREE_READONLY (gfor_fndecl_math_ishftc16)((non_type_check ((gfor_fndecl_math_ishftc16), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3687, __FUNCTION__))->base.readonly_flag) = 1;
3688 TREE_NOTHROW (gfor_fndecl_math_ishftc16)((gfor_fndecl_math_ishftc16)->base.nothrow_flag) = 1;
3689 }
3690
3691 /* BLAS functions. */
3692 {
3693 tree pint = build_pointer_type (integer_type_nodeinteger_types[itk_int]);
3694 tree ps = build_pointer_type (gfc_get_real_type (gfc_default_real_kind));
3695 tree pd = build_pointer_type (gfc_get_real_type (gfc_default_double_kind));
3696 tree pc = build_pointer_type (gfc_get_complex_type (gfc_default_real_kind));
3697 tree pz = build_pointer_type
3698 (gfc_get_complex_type (gfc_default_double_kind));
3699
3700 gfor_fndecl_sgemm = gfc_build_library_function_decl
3701 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "sgemm_"
: "sgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "sgemm_" : "sgemm"), strlen (global_options.x_flag_underscoring
? "sgemm_" : "sgemm")) : get_identifier (global_options.x_flag_underscoring
? "sgemm_" : "sgemm"))
3702 (flag_underscoring ? "sgemm_" : "sgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "sgemm_"
: "sgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "sgemm_" : "sgemm"), strlen (global_options.x_flag_underscoring
? "sgemm_" : "sgemm")) : get_identifier (global_options.x_flag_underscoring
? "sgemm_" : "sgemm")),
3703 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3704 pchar_type_node, pint, pint, pint, ps, ps, pint,
3705 ps, pint, ps, ps, pint, integer_type_nodeinteger_types[itk_int],
3706 integer_type_nodeinteger_types[itk_int]);
3707 gfor_fndecl_dgemm = gfc_build_library_function_decl
3708 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "dgemm_"
: "dgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "dgemm_" : "dgemm"), strlen (global_options.x_flag_underscoring
? "dgemm_" : "dgemm")) : get_identifier (global_options.x_flag_underscoring
? "dgemm_" : "dgemm"))
3709 (flag_underscoring ? "dgemm_" : "dgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "dgemm_"
: "dgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "dgemm_" : "dgemm"), strlen (global_options.x_flag_underscoring
? "dgemm_" : "dgemm")) : get_identifier (global_options.x_flag_underscoring
? "dgemm_" : "dgemm")),
3710 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3711 pchar_type_node, pint, pint, pint, pd, pd, pint,
3712 pd, pint, pd, pd, pint, integer_type_nodeinteger_types[itk_int],
3713 integer_type_nodeinteger_types[itk_int]);
3714 gfor_fndecl_cgemm = gfc_build_library_function_decl
3715 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "cgemm_"
: "cgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "cgemm_" : "cgemm"), strlen (global_options.x_flag_underscoring
? "cgemm_" : "cgemm")) : get_identifier (global_options.x_flag_underscoring
? "cgemm_" : "cgemm"))
3716 (flag_underscoring ? "cgemm_" : "cgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "cgemm_"
: "cgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "cgemm_" : "cgemm"), strlen (global_options.x_flag_underscoring
? "cgemm_" : "cgemm")) : get_identifier (global_options.x_flag_underscoring
? "cgemm_" : "cgemm")),
3717 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3718 pchar_type_node, pint, pint, pint, pc, pc, pint,
3719 pc, pint, pc, pc, pint, integer_type_nodeinteger_types[itk_int],
3720 integer_type_nodeinteger_types[itk_int]);
3721 gfor_fndecl_zgemm = gfc_build_library_function_decl
3722 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "zgemm_"
: "zgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "zgemm_" : "zgemm"), strlen (global_options.x_flag_underscoring
? "zgemm_" : "zgemm")) : get_identifier (global_options.x_flag_underscoring
? "zgemm_" : "zgemm"))
3723 (flag_underscoring ? "zgemm_" : "zgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "zgemm_"
: "zgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "zgemm_" : "zgemm"), strlen (global_options.x_flag_underscoring
? "zgemm_" : "zgemm")) : get_identifier (global_options.x_flag_underscoring
? "zgemm_" : "zgemm")),
3724 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3725 pchar_type_node, pint, pint, pint, pz, pz, pint,
3726 pz, pint, pz, pz, pint, integer_type_nodeinteger_types[itk_int],
3727 integer_type_nodeinteger_types[itk_int]);
3728 }
3729
3730 /* Other functions. */
3731 gfor_fndecl_iargc = gfc_build_library_function_decl (
3732 get_identifier (PREFIX ("iargc"))(__builtin_constant_p ("_gfortran_" "iargc") ? get_identifier_with_length
(("_gfortran_" "iargc"), strlen ("_gfortran_" "iargc")) : get_identifier
("_gfortran_" "iargc")), gfc_int4_type_node, 0);
3733 TREE_NOTHROW (gfor_fndecl_iargc)((gfor_fndecl_iargc)->base.nothrow_flag) = 1;
3734
3735 gfor_fndecl_kill_sub = gfc_build_library_function_decl (
3736 get_identifier (PREFIX ("kill_sub"))(__builtin_constant_p ("_gfortran_" "kill_sub") ? get_identifier_with_length
(("_gfortran_" "kill_sub"), strlen ("_gfortran_" "kill_sub")
) : get_identifier ("_gfortran_" "kill_sub")), void_type_nodeglobal_trees[TI_VOID_TYPE],
3737 3, gfc_int4_type_node, gfc_int4_type_node, gfc_pint4_type_node);
3738
3739 gfor_fndecl_kill = gfc_build_library_function_decl (
3740 get_identifier (PREFIX ("kill"))(__builtin_constant_p ("_gfortran_" "kill") ? get_identifier_with_length
(("_gfortran_" "kill"), strlen ("_gfortran_" "kill")) : get_identifier
("_gfortran_" "kill")), gfc_int4_type_node,
3741 2, gfc_int4_type_node, gfc_int4_type_node);
3742
3743 gfor_fndecl_is_contiguous0 = gfc_build_library_function_decl_with_spec (
3744 get_identifier (PREFIX("is_contiguous0"))(__builtin_constant_p ("_gfortran_" "is_contiguous0") ? get_identifier_with_length
(("_gfortran_" "is_contiguous0"), strlen ("_gfortran_" "is_contiguous0"
)) : get_identifier ("_gfortran_" "is_contiguous0")), ". R ",
3745 gfc_int4_type_node, 1, pvoid_type_node);
3746 DECL_PURE_P (gfor_fndecl_is_contiguous0)((tree_check ((gfor_fndecl_is_contiguous0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3746, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3747 TREE_NOTHROW (gfor_fndecl_is_contiguous0)((gfor_fndecl_is_contiguous0)->base.nothrow_flag) = 1;
3748}
3749
3750
3751/* Make prototypes for runtime library functions. */
3752
3753void
3754gfc_build_builtin_function_decls (void)
3755{
3756 tree gfc_int8_type_node = gfc_get_int_type (8);
3757
3758 gfor_fndecl_stop_numeric = gfc_build_library_function_decl (
3759 get_identifier (PREFIX("stop_numeric"))(__builtin_constant_p ("_gfortran_" "stop_numeric") ? get_identifier_with_length
(("_gfortran_" "stop_numeric"), strlen ("_gfortran_" "stop_numeric"
)) : get_identifier ("_gfortran_" "stop_numeric")),
3760 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3761 /* STOP doesn't return. */
3762 TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric)((gfor_fndecl_stop_numeric)->base.volatile_flag) = 1;
3763
3764 gfor_fndecl_stop_string = gfc_build_library_function_decl_with_spec (
3765 get_identifier (PREFIX("stop_string"))(__builtin_constant_p ("_gfortran_" "stop_string") ? get_identifier_with_length
(("_gfortran_" "stop_string"), strlen ("_gfortran_" "stop_string"
)) : get_identifier ("_gfortran_" "stop_string")), ". R . . ",
3766 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3767 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3768 /* STOP doesn't return. */
3769 TREE_THIS_VOLATILE (gfor_fndecl_stop_string)((gfor_fndecl_stop_string)->base.volatile_flag) = 1;
3770
3771 gfor_fndecl_error_stop_numeric = gfc_build_library_function_decl (
3772 get_identifier (PREFIX("error_stop_numeric"))(__builtin_constant_p ("_gfortran_" "error_stop_numeric") ? get_identifier_with_length
(("_gfortran_" "error_stop_numeric"), strlen ("_gfortran_" "error_stop_numeric"
)) : get_identifier ("_gfortran_" "error_stop_numeric")),
3773 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3774 /* ERROR STOP doesn't return. */
3775 TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric)((gfor_fndecl_error_stop_numeric)->base.volatile_flag) = 1;
3776
3777 gfor_fndecl_error_stop_string = gfc_build_library_function_decl_with_spec (
3778 get_identifier (PREFIX("error_stop_string"))(__builtin_constant_p ("_gfortran_" "error_stop_string") ? get_identifier_with_length
(("_gfortran_" "error_stop_string"), strlen ("_gfortran_" "error_stop_string"
)) : get_identifier ("_gfortran_" "error_stop_string")), ". R . . ",
3779 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3780 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3781 /* ERROR STOP doesn't return. */
3782 TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string)((gfor_fndecl_error_stop_string)->base.volatile_flag) = 1;
3783
3784 gfor_fndecl_pause_numeric = gfc_build_library_function_decl (
3785 get_identifier (PREFIX("pause_numeric"))(__builtin_constant_p ("_gfortran_" "pause_numeric") ? get_identifier_with_length
(("_gfortran_" "pause_numeric"), strlen ("_gfortran_" "pause_numeric"
)) : get_identifier ("_gfortran_" "pause_numeric")),
3786 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, gfc_int8_type_node);
3787
3788 gfor_fndecl_pause_string = gfc_build_library_function_decl_with_spec (
3789 get_identifier (PREFIX("pause_string"))(__builtin_constant_p ("_gfortran_" "pause_string") ? get_identifier_with_length
(("_gfortran_" "pause_string"), strlen ("_gfortran_" "pause_string"
)) : get_identifier ("_gfortran_" "pause_string")), ". R . ",
3790 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3791
3792 gfor_fndecl_runtime_error = gfc_build_library_function_decl_with_spec (
3793 get_identifier (PREFIX("runtime_error"))(__builtin_constant_p ("_gfortran_" "runtime_error") ? get_identifier_with_length
(("_gfortran_" "runtime_error"), strlen ("_gfortran_" "runtime_error"
)) : get_identifier ("_gfortran_" "runtime_error")), ". R ",
3794 void_type_nodeglobal_trees[TI_VOID_TYPE], -1, pchar_type_node);
3795 /* The runtime_error function does not return. */
3796 TREE_THIS_VOLATILE (gfor_fndecl_runtime_error)((gfor_fndecl_runtime_error)->base.volatile_flag) = 1;
3797
3798 gfor_fndecl_runtime_error_at = gfc_build_library_function_decl_with_spec (
3799 get_identifier (PREFIX("runtime_error_at"))(__builtin_constant_p ("_gfortran_" "runtime_error_at") ? get_identifier_with_length
(("_gfortran_" "runtime_error_at"), strlen ("_gfortran_" "runtime_error_at"
)) : get_identifier ("_gfortran_" "runtime_error_at")), ". R R ",
3800 void_type_nodeglobal_trees[TI_VOID_TYPE], -2, pchar_type_node, pchar_type_node);
3801 /* The runtime_error_at function does not return. */
3802 TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at)((gfor_fndecl_runtime_error_at)->base.volatile_flag) = 1;
3803
3804 gfor_fndecl_runtime_warning_at = gfc_build_library_function_decl_with_spec (
3805 get_identifier (PREFIX("runtime_warning_at"))(__builtin_constant_p ("_gfortran_" "runtime_warning_at") ? get_identifier_with_length
(("_gfortran_" "runtime_warning_at"), strlen ("_gfortran_" "runtime_warning_at"
)) : get_identifier ("_gfortran_" "runtime_warning_at")), ". R R ",
3806 void_type_nodeglobal_trees[TI_VOID_TYPE], -2, pchar_type_node, pchar_type_node);
3807
3808 gfor_fndecl_generate_error = gfc_build_library_function_decl_with_spec (
3809 get_identifier (PREFIX("generate_error"))(__builtin_constant_p ("_gfortran_" "generate_error") ? get_identifier_with_length
(("_gfortran_" "generate_error"), strlen ("_gfortran_" "generate_error"
)) : get_identifier ("_gfortran_" "generate_error")), ". R . R ",
3810 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3811 pchar_type_node);
3812
3813 gfor_fndecl_os_error_at = gfc_build_library_function_decl_with_spec (
3814 get_identifier (PREFIX("os_error_at"))(__builtin_constant_p ("_gfortran_" "os_error_at") ? get_identifier_with_length
(("_gfortran_" "os_error_at"), strlen ("_gfortran_" "os_error_at"
)) : get_identifier ("_gfortran_" "os_error_at")), ". R R ",
3815 void_type_nodeglobal_trees[TI_VOID_TYPE], -2, pchar_type_node, pchar_type_node);
3816 /* The os_error_at function does not return. */
3817 TREE_THIS_VOLATILE (gfor_fndecl_os_error_at)((gfor_fndecl_os_error_at)->base.volatile_flag) = 1;
3818
3819 gfor_fndecl_set_args = gfc_build_library_function_decl (
3820 get_identifier (PREFIX("set_args"))(__builtin_constant_p ("_gfortran_" "set_args") ? get_identifier_with_length
(("_gfortran_" "set_args"), strlen ("_gfortran_" "set_args")
) : get_identifier ("_gfortran_" "set_args")),
3821 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int],
3822 build_pointer_type (pchar_type_node));
3823
3824 gfor_fndecl_set_fpe = gfc_build_library_function_decl (
3825 get_identifier (PREFIX("set_fpe"))(__builtin_constant_p ("_gfortran_" "set_fpe") ? get_identifier_with_length
(("_gfortran_" "set_fpe"), strlen ("_gfortran_" "set_fpe")) :
get_identifier ("_gfortran_" "set_fpe")),
3826 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3827
3828 gfor_fndecl_ieee_procedure_entry = gfc_build_library_function_decl (
3829 get_identifier (PREFIX("ieee_procedure_entry"))(__builtin_constant_p ("_gfortran_" "ieee_procedure_entry") ?
get_identifier_with_length (("_gfortran_" "ieee_procedure_entry"
), strlen ("_gfortran_" "ieee_procedure_entry")) : get_identifier
("_gfortran_" "ieee_procedure_entry")),
3830 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, pvoid_type_node);
3831
3832 gfor_fndecl_ieee_procedure_exit = gfc_build_library_function_decl (
3833 get_identifier (PREFIX("ieee_procedure_exit"))(__builtin_constant_p ("_gfortran_" "ieee_procedure_exit") ? get_identifier_with_length
(("_gfortran_" "ieee_procedure_exit"), strlen ("_gfortran_" "ieee_procedure_exit"
)) : get_identifier ("_gfortran_" "ieee_procedure_exit")),
3834 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, pvoid_type_node);
3835
3836 /* Keep the array dimension in sync with the call, later in this file. */
3837 gfor_fndecl_set_options = gfc_build_library_function_decl_with_spec (
3838 get_identifier (PREFIX("set_options"))(__builtin_constant_p ("_gfortran_" "set_options") ? get_identifier_with_length
(("_gfortran_" "set_options"), strlen ("_gfortran_" "set_options"
)) : get_identifier ("_gfortran_" "set_options")), ". . R ",
3839 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int],
3840 build_pointer_type (integer_type_nodeinteger_types[itk_int]));
3841
3842 gfor_fndecl_set_convert = gfc_build_library_function_decl (
3843 get_identifier (PREFIX("set_convert"))(__builtin_constant_p ("_gfortran_" "set_convert") ? get_identifier_with_length
(("_gfortran_" "set_convert"), strlen ("_gfortran_" "set_convert"
)) : get_identifier ("_gfortran_" "set_convert")),
3844 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3845
3846 gfor_fndecl_set_record_marker = gfc_build_library_function_decl (
3847 get_identifier (PREFIX("set_record_marker"))(__builtin_constant_p ("_gfortran_" "set_record_marker") ? get_identifier_with_length
(("_gfortran_" "set_record_marker"), strlen ("_gfortran_" "set_record_marker"
)) : get_identifier ("_gfortran_" "set_record_marker")),
3848 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3849
3850 gfor_fndecl_set_max_subrecord_length = gfc_build_library_function_decl (
3851 get_identifier (PREFIX("set_max_subrecord_length"))(__builtin_constant_p ("_gfortran_" "set_max_subrecord_length"
) ? get_identifier_with_length (("_gfortran_" "set_max_subrecord_length"
), strlen ("_gfortran_" "set_max_subrecord_length")) : get_identifier
("_gfortran_" "set_max_subrecord_length")),
3852 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3853
3854 gfor_fndecl_in_pack = gfc_build_library_function_decl_with_spec (
3855 get_identifier (PREFIX("internal_pack"))(__builtin_constant_p ("_gfortran_" "internal_pack") ? get_identifier_with_length
(("_gfortran_" "internal_pack"), strlen ("_gfortran_" "internal_pack"
)) : get_identifier ("_gfortran_" "internal_pack")), ". r ",
3856 pvoid_type_node, 1, pvoid_type_node);
3857
3858 gfor_fndecl_in_unpack = gfc_build_library_function_decl_with_spec (
3859 get_identifier (PREFIX("internal_unpack"))(__builtin_constant_p ("_gfortran_" "internal_unpack") ? get_identifier_with_length
(("_gfortran_" "internal_unpack"), strlen ("_gfortran_" "internal_unpack"
)) : get_identifier ("_gfortran_" "internal_unpack")), ". w R ",
3860 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pvoid_type_node, pvoid_type_node);
3861
3862 gfor_fndecl_associated = gfc_build_library_function_decl_with_spec (
3863 get_identifier (PREFIX("associated"))(__builtin_constant_p ("_gfortran_" "associated") ? get_identifier_with_length
(("_gfortran_" "associated"), strlen ("_gfortran_" "associated"
)) : get_identifier ("_gfortran_" "associated")), ". R R ",
3864 integer_type_nodeinteger_types[itk_int], 2, ppvoid_type_node, ppvoid_type_node);
3865 DECL_PURE_P (gfor_fndecl_associated)((tree_check ((gfor_fndecl_associated), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 3865, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
) = 1;
3866 TREE_NOTHROW (gfor_fndecl_associated)((gfor_fndecl_associated)->base.nothrow_flag) = 1;
3867
3868 /* Coarray library calls. */
3869 if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
3870 {
3871 tree pint_type, pppchar_type;
3872
3873 pint_type = build_pointer_type (integer_type_nodeinteger_types[itk_int]);
3874 pppchar_type
3875 = build_pointer_type (build_pointer_type (pchar_type_node));
3876
3877 gfor_fndecl_caf_init = gfc_build_library_function_decl_with_spec (
3878 get_identifier (PREFIX("caf_init"))(__builtin_constant_p ("_gfortran_" "caf_init") ? get_identifier_with_length
(("_gfortran_" "caf_init"), strlen ("_gfortran_" "caf_init")
) : get_identifier ("_gfortran_" "caf_init")), ". W W ",
3879 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pint_type, pppchar_type);
3880
3881 gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
3882 get_identifier (PREFIX("caf_finalize"))(__builtin_constant_p ("_gfortran_" "caf_finalize") ? get_identifier_with_length
(("_gfortran_" "caf_finalize"), strlen ("_gfortran_" "caf_finalize"
)) : get_identifier ("_gfortran_" "caf_finalize")), void_type_nodeglobal_trees[TI_VOID_TYPE], 0);
3883
3884 gfor_fndecl_caf_this_image = gfc_build_library_function_decl (
3885 get_identifier (PREFIX("caf_this_image"))(__builtin_constant_p ("_gfortran_" "caf_this_image") ? get_identifier_with_length
(("_gfortran_" "caf_this_image"), strlen ("_gfortran_" "caf_this_image"
)) : get_identifier ("_gfortran_" "caf_this_image")), integer_type_nodeinteger_types[itk_int],
3886 1, integer_type_nodeinteger_types[itk_int]);
3887
3888 gfor_fndecl_caf_num_images = gfc_build_library_function_decl (
3889 get_identifier (PREFIX("caf_num_images"))(__builtin_constant_p ("_gfortran_" "caf_num_images") ? get_identifier_with_length
(("_gfortran_" "caf_num_images"), strlen ("_gfortran_" "caf_num_images"
)) : get_identifier ("_gfortran_" "caf_num_images")), integer_type_nodeinteger_types[itk_int],
3890 2, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3891
3892 gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
3893 get_identifier (PREFIX("caf_register"))(__builtin_constant_p ("_gfortran_" "caf_register") ? get_identifier_with_length
(("_gfortran_" "caf_register"), strlen ("_gfortran_" "caf_register"
)) : get_identifier ("_gfortran_" "caf_register")), ". . . W w w w . ",
3894 void_type_nodeglobal_trees[TI_VOID_TYPE], 7,
3895 size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int], ppvoid_type_node, pvoid_type_node,
3896 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3897
3898 gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
3899 get_identifier (PREFIX("caf_deregister"))(__builtin_constant_p ("_gfortran_" "caf_deregister") ? get_identifier_with_length
(("_gfortran_" "caf_deregister"), strlen ("_gfortran_" "caf_deregister"
)) : get_identifier ("_gfortran_" "caf_deregister")), ". W . w w . ",
3900 void_type_nodeglobal_trees[TI_VOID_TYPE], 5,
3901 ppvoid_type_node, integer_type_nodeinteger_types[itk_int], pint_type, pchar_type_node,
3902 size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3903
3904 gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
3905 get_identifier (PREFIX("caf_get"))(__builtin_constant_p ("_gfortran_" "caf_get") ? get_identifier_with_length
(("_gfortran_" "caf_get"), strlen ("_gfortran_" "caf_get")) :
get_identifier ("_gfortran_" "caf_get")), ". r . . r r w . . . w ",
3906 void_type_nodeglobal_trees[TI_VOID_TYPE], 10,
3907 pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3908 pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3909 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type);
3910
3911 gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
3912 get_identifier (PREFIX("caf_send"))(__builtin_constant_p ("_gfortran_" "caf_send") ? get_identifier_with_length
(("_gfortran_" "caf_send"), strlen ("_gfortran_" "caf_send")
) : get_identifier ("_gfortran_" "caf_send")), ". r . . w r r . . . w ",
3913 void_type_nodeglobal_trees[TI_VOID_TYPE], 11,
3914 pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3915 pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3916 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, pvoid_type_node);
3917
3918 gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
3919 get_identifier (PREFIX("caf_sendget"))(__builtin_constant_p ("_gfortran_" "caf_sendget") ? get_identifier_with_length
(("_gfortran_" "caf_sendget"), strlen ("_gfortran_" "caf_sendget"
)) : get_identifier ("_gfortran_" "caf_sendget")), ". r . . w r r . . r r . . . w ",
3920 void_type_nodeglobal_trees[TI_VOID_TYPE], 14, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3921 pvoid_type_node, pvoid_type_node, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3922 integer_type_nodeinteger_types[itk_int], pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3923 integer_type_nodeinteger_types[itk_int], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], integer_type_nodeinteger_types[itk_int]);
3924
3925 gfor_fndecl_caf_get_by_ref = gfc_build_library_function_decl_with_spec (
3926 get_identifier (PREFIX("caf_get_by_ref"))(__builtin_constant_p ("_gfortran_" "caf_get_by_ref") ? get_identifier_with_length
(("_gfortran_" "caf_get_by_ref"), strlen ("_gfortran_" "caf_get_by_ref"
)) : get_identifier ("_gfortran_" "caf_get_by_ref")), ". r . w r . . . . w . ",
3927 void_type_nodeglobal_trees[TI_VOID_TYPE],
3928 10, pvoid_type_node, integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3929 pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3930 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, integer_type_nodeinteger_types[itk_int]);
3931
3932 gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec (
3933 get_identifier (PREFIX("caf_send_by_ref"))(__builtin_constant_p ("_gfortran_" "caf_send_by_ref") ? get_identifier_with_length
(("_gfortran_" "caf_send_by_ref"), strlen ("_gfortran_" "caf_send_by_ref"
)) : get_identifier ("_gfortran_" "caf_send_by_ref")), ". r . r r . . . . w . ",
3934 void_type_nodeglobal_trees[TI_VOID_TYPE], 10, pvoid_type_node, integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3935 pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3936 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, integer_type_nodeinteger_types[itk_int]);
3937
3938 gfor_fndecl_caf_sendget_by_ref
3939 = gfc_build_library_function_decl_with_spec (
3940 get_identifier (PREFIX("caf_sendget_by_ref"))(__builtin_constant_p ("_gfortran_" "caf_sendget_by_ref") ? get_identifier_with_length
(("_gfortran_" "caf_sendget_by_ref"), strlen ("_gfortran_" "caf_sendget_by_ref"
)) : get_identifier ("_gfortran_" "caf_sendget_by_ref")),
3941 ". r . r r . r . . . w w . . ",
3942 void_type_nodeglobal_trees[TI_VOID_TYPE], 13, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3943 pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3944 pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3945 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, pint_type, integer_type_nodeinteger_types[itk_int],
3946 integer_type_nodeinteger_types[itk_int]);
3947
3948 gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
3949 get_identifier (PREFIX("caf_sync_all"))(__builtin_constant_p ("_gfortran_" "caf_sync_all") ? get_identifier_with_length
(("_gfortran_" "caf_sync_all"), strlen ("_gfortran_" "caf_sync_all"
)) : get_identifier ("_gfortran_" "caf_sync_all")), ". w w . ", void_type_nodeglobal_trees[TI_VOID_TYPE],
3950 3, pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3951
3952 gfor_fndecl_caf_sync_memory = gfc_build_library_function_decl_with_spec (
3953 get_identifier (PREFIX("caf_sync_memory"))(__builtin_constant_p ("_gfortran_" "caf_sync_memory") ? get_identifier_with_length
(("_gfortran_" "caf_sync_memory"), strlen ("_gfortran_" "caf_sync_memory"
)) : get_identifier ("_gfortran_" "caf_sync_memory")), ". w w . ", void_type_nodeglobal_trees[TI_VOID_TYPE],
3954 3, pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3955
3956 gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
3957 get_identifier (PREFIX("caf_sync_images"))(__builtin_constant_p ("_gfortran_" "caf_sync_images") ? get_identifier_with_length
(("_gfortran_" "caf_sync_images"), strlen ("_gfortran_" "caf_sync_images"
)) : get_identifier ("_gfortran_" "caf_sync_images")), ". . r w w . ", void_type_nodeglobal_trees[TI_VOID_TYPE],
3958 5, integer_type_nodeinteger_types[itk_int], pint_type, pint_type,
3959 pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3960
3961 gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
3962 get_identifier (PREFIX("caf_error_stop"))(__builtin_constant_p ("_gfortran_" "caf_error_stop") ? get_identifier_with_length
(("_gfortran_" "caf_error_stop"), strlen ("_gfortran_" "caf_error_stop"
)) : get_identifier ("_gfortran_" "caf_error_stop")),
3963 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3964 /* CAF's ERROR STOP doesn't return. */
3965 TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop)((gfor_fndecl_caf_error_stop)->base.volatile_flag) = 1;
3966
3967 gfor_fndecl_caf_error_stop_str = gfc_build_library_function_decl_with_spec (
3968 get_identifier (PREFIX("caf_error_stop_str"))(__builtin_constant_p ("_gfortran_" "caf_error_stop_str") ? get_identifier_with_length
(("_gfortran_" "caf_error_stop_str"), strlen ("_gfortran_" "caf_error_stop_str"
)) : get_identifier ("_gfortran_" "caf_error_stop_str")), ". r . ",
3969 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3970 /* CAF's ERROR STOP doesn't return. */
3971 TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str)((gfor_fndecl_caf_error_stop_str)->base.volatile_flag) = 1;
3972
3973 gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl (
3974 get_identifier (PREFIX("caf_stop_numeric"))(__builtin_constant_p ("_gfortran_" "caf_stop_numeric") ? get_identifier_with_length
(("_gfortran_" "caf_stop_numeric"), strlen ("_gfortran_" "caf_stop_numeric"
)) : get_identifier ("_gfortran_" "caf_stop_numeric")),
3975 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3976 /* CAF's STOP doesn't return. */
3977 TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric)((gfor_fndecl_caf_stop_numeric)->base.volatile_flag) = 1;
3978
3979 gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec (
3980 get_identifier (PREFIX("caf_stop_str"))(__builtin_constant_p ("_gfortran_" "caf_stop_str") ? get_identifier_with_length
(("_gfortran_" "caf_stop_str"), strlen ("_gfortran_" "caf_stop_str"
)) : get_identifier ("_gfortran_" "caf_stop_str")), ". r . ",
3981 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3982 /* CAF's STOP doesn't return. */
3983 TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str)((gfor_fndecl_caf_stop_str)->base.volatile_flag) = 1;
3984
3985 gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
3986 get_identifier (PREFIX("caf_atomic_define"))(__builtin_constant_p ("_gfortran_" "caf_atomic_define") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_define"), strlen ("_gfortran_" "caf_atomic_define"
)) : get_identifier ("_gfortran_" "caf_atomic_define")), ". r . . w w . . ",
3987 void_type_nodeglobal_trees[TI_VOID_TYPE], 7, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3988 pvoid_type_node, pint_type, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3989
3990 gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
3991 get_identifier (PREFIX("caf_atomic_ref"))(__builtin_constant_p ("_gfortran_" "caf_atomic_ref") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_ref"), strlen ("_gfortran_" "caf_atomic_ref"
)) : get_identifier ("_gfortran_" "caf_atomic_ref")), ". r . . w w . . ",
3992 void_type_nodeglobal_trees[TI_VOID_TYPE], 7, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3993 pvoid_type_node, pint_type, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3994
3995 gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
3996 get_identifier (PREFIX("caf_atomic_cas"))(__builtin_constant_p ("_gfortran_" "caf_atomic_cas") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_cas"), strlen ("_gfortran_" "caf_atomic_cas"
)) : get_identifier ("_gfortran_" "caf_atomic_cas")), ". r . . w r r w . . ",
3997 void_type_nodeglobal_trees[TI_VOID_TYPE], 9, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3998 pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
3999 integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
4000
4001 gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
4002 get_identifier (PREFIX("caf_atomic_op"))(__builtin_constant_p ("_gfortran_" "caf_atomic_op") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_op"), strlen ("_gfortran_" "caf_atomic_op"
)) : get_identifier ("_gfortran_" "caf_atomic_op")), ". . r . . r w w . . ",
4003 void_type_nodeglobal_trees[TI_VOID_TYPE], 9, integer_type_nodeinteger_types[itk_int], pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
4004 integer_type_nodeinteger_types[itk_int], pvoid_type_node, pvoid_type_node, pint_type,
4005 integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
4006
4007 gfor_fndecl_caf_lock = gfc_build_library_function_decl_with_spec (
4008 get_identifier (PREFIX("caf_lock"))(__builtin_constant_p ("_gfortran_" "caf_lock") ? get_identifier_with_length
(("_gfortran_" "caf_lock"), strlen ("_gfortran_" "caf_lock")
) : get_identifier ("_gfortran_" "caf_lock")), ". r . . w w w . ",
4009 void_type_nodeglobal_trees[TI_VOID_TYPE], 7, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
4010 pint_type, pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4011
4012 gfor_fndecl_caf_unlock = gfc_build_library_function_decl_with_spec (
4013 get_identifier (PREFIX("caf_unlock"))(__builtin_constant_p ("_gfortran_" "caf_unlock") ? get_identifier_with_length
(("_gfortran_" "caf_unlock"), strlen ("_gfortran_" "caf_unlock"
)) : get_identifier ("_gfortran_" "caf_unlock")), ". r . . w w . ",
4014 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
4015 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4016
4017 gfor_fndecl_caf_event_post = gfc_build_library_function_decl_with_spec (
4018 get_identifier (PREFIX("caf_event_post"))(__builtin_constant_p ("_gfortran_" "caf_event_post") ? get_identifier_with_length
(("_gfortran_" "caf_event_post"), strlen ("_gfortran_" "caf_event_post"
)) : get_identifier ("_gfortran_" "caf_event_post")), ". r . . w w . ",
4019 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
4020 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4021
4022 gfor_fndecl_caf_event_wait = gfc_build_library_function_decl_with_spec (
4023 get_identifier (PREFIX("caf_event_wait"))(__builtin_constant_p ("_gfortran_" "caf_event_wait") ? get_identifier_with_length
(("_gfortran_" "caf_event_wait"), strlen ("_gfortran_" "caf_event_wait"
)) : get_identifier ("_gfortran_" "caf_event_wait")), ". r . . w w . ",
4024 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
4025 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4026
4027 gfor_fndecl_caf_event_query = gfc_build_library_function_decl_with_spec (
4028 get_identifier (PREFIX("caf_event_query"))(__builtin_constant_p ("_gfortran_" "caf_event_query") ? get_identifier_with_length
(("_gfortran_" "caf_event_query"), strlen ("_gfortran_" "caf_event_query"
)) : get_identifier ("_gfortran_" "caf_event_query")), ". r . . w w ",
4029 void_type_nodeglobal_trees[TI_VOID_TYPE], 5, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
4030 pint_type, pint_type);
4031
4032 gfor_fndecl_caf_fail_image = gfc_build_library_function_decl (
4033 get_identifier (PREFIX("caf_fail_image"))(__builtin_constant_p ("_gfortran_" "caf_fail_image") ? get_identifier_with_length
(("_gfortran_" "caf_fail_image"), strlen ("_gfortran_" "caf_fail_image"
)) : get_identifier ("_gfortran_" "caf_fail_image")), void_type_nodeglobal_trees[TI_VOID_TYPE], 0);
4034 /* CAF's FAIL doesn't return. */
4035 TREE_THIS_VOLATILE (gfor_fndecl_caf_fail_image)((gfor_fndecl_caf_fail_image)->base.volatile_flag) = 1;
4036
4037 gfor_fndecl_caf_failed_images
4038 = gfc_build_library_function_decl_with_spec (
4039 get_identifier (PREFIX("caf_failed_images"))(__builtin_constant_p ("_gfortran_" "caf_failed_images") ? get_identifier_with_length
(("_gfortran_" "caf_failed_images"), strlen ("_gfortran_" "caf_failed_images"
)) : get_identifier ("_gfortran_" "caf_failed_images")), ". w . r ",
4040 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pvoid_type_node, ppvoid_type_node,
4041 integer_type_nodeinteger_types[itk_int]);
4042
4043 gfor_fndecl_caf_form_team
4044 = gfc_build_library_function_decl_with_spec (
4045 get_identifier (PREFIX("caf_form_team"))(__builtin_constant_p ("_gfortran_" "caf_form_team") ? get_identifier_with_length
(("_gfortran_" "caf_form_team"), strlen ("_gfortran_" "caf_form_team"
)) : get_identifier ("_gfortran_" "caf_form_team")), ". . W . ",
4046 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, integer_type_nodeinteger_types[itk_int], ppvoid_type_node,
4047 integer_type_nodeinteger_types[itk_int]);
4048
4049 gfor_fndecl_caf_change_team
4050 = gfc_build_library_function_decl_with_spec (
4051 get_identifier (PREFIX("caf_change_team"))(__builtin_constant_p ("_gfortran_" "caf_change_team") ? get_identifier_with_length
(("_gfortran_" "caf_change_team"), strlen ("_gfortran_" "caf_change_team"
)) : get_identifier ("_gfortran_" "caf_change_team")), ". w . ",
4052 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, ppvoid_type_node,
4053 integer_type_nodeinteger_types[itk_int]);
4054
4055 gfor_fndecl_caf_end_team
4056 = gfc_build_library_function_decl (
4057 get_identifier (PREFIX("caf_end_team"))(__builtin_constant_p ("_gfortran_" "caf_end_team") ? get_identifier_with_length
(("_gfortran_" "caf_end_team"), strlen ("_gfortran_" "caf_end_team"
)) : get_identifier ("_gfortran_" "caf_end_team")), void_type_nodeglobal_trees[TI_VOID_TYPE], 0);
4058
4059 gfor_fndecl_caf_get_team
4060 = gfc_build_library_function_decl (
4061 get_identifier (PREFIX("caf_get_team"))(__builtin_constant_p ("_gfortran_" "caf_get_team") ? get_identifier_with_length
(("_gfortran_" "caf_get_team"), strlen ("_gfortran_" "caf_get_team"
)) : get_identifier ("_gfortran_" "caf_get_team")),
4062 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
4063
4064 gfor_fndecl_caf_sync_team
4065 = gfc_build_library_function_decl_with_spec (
4066 get_identifier (PREFIX("caf_sync_team"))(__builtin_constant_p ("_gfortran_" "caf_sync_team") ? get_identifier_with_length
(("_gfortran_" "caf_sync_team"), strlen ("_gfortran_" "caf_sync_team"
)) : get_identifier ("_gfortran_" "caf_sync_team")), ". r . ",
4067 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, ppvoid_type_node,
4068 integer_type_nodeinteger_types[itk_int]);
4069
4070 gfor_fndecl_caf_team_number
4071 = gfc_build_library_function_decl_with_spec (
4072 get_identifier (PREFIX("caf_team_number"))(__builtin_constant_p ("_gfortran_" "caf_team_number") ? get_identifier_with_length
(("_gfortran_" "caf_team_number"), strlen ("_gfortran_" "caf_team_number"
)) : get_identifier ("_gfortran_" "caf_team_number")), ". r ",
4073 integer_type_nodeinteger_types[itk_int], 1, integer_type_nodeinteger_types[itk_int]);
4074
4075 gfor_fndecl_caf_image_status
4076 = gfc_build_library_function_decl_with_spec (
4077 get_identifier (PREFIX("caf_image_status"))(__builtin_constant_p ("_gfortran_" "caf_image_status") ? get_identifier_with_length
(("_gfortran_" "caf_image_status"), strlen ("_gfortran_" "caf_image_status"
)) : get_identifier ("_gfortran_" "caf_image_status")), ". . r ",
4078 integer_type_nodeinteger_types[itk_int], 2, integer_type_nodeinteger_types[itk_int], ppvoid_type_node);
4079
4080 gfor_fndecl_caf_stopped_images
4081 = gfc_build_library_function_decl_with_spec (
4082 get_identifier (PREFIX("caf_stopped_images"))(__builtin_constant_p ("_gfortran_" "caf_stopped_images") ? get_identifier_with_length
(("_gfortran_" "caf_stopped_images"), strlen ("_gfortran_" "caf_stopped_images"
)) : get_identifier ("_gfortran_" "caf_stopped_images")), ". w r r ",
4083 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pvoid_type_node, ppvoid_type_node,
4084 integer_type_nodeinteger_types[itk_int]);
4085
4086 gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
4087 get_identifier (PREFIX("caf_co_broadcast"))(__builtin_constant_p ("_gfortran_" "caf_co_broadcast") ? get_identifier_with_length
(("_gfortran_" "caf_co_broadcast"), strlen ("_gfortran_" "caf_co_broadcast"
)) : get_identifier ("_gfortran_" "caf_co_broadcast")), ". w . w w . ",
4088 void_type_nodeglobal_trees[TI_VOID_TYPE], 5, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4089 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4090
4091 gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
4092 get_identifier (PREFIX("caf_co_max"))(__builtin_constant_p ("_gfortran_" "caf_co_max") ? get_identifier_with_length
(("_gfortran_" "caf_co_max"), strlen ("_gfortran_" "caf_co_max"
)) : get_identifier ("_gfortran_" "caf_co_max")), ". w . w w . . ",
4093 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4094 pint_type, pchar_type_node, integer_type_nodeinteger_types[itk_int], size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4095
4096 gfor_fndecl_co_min = gfc_build_library_function_decl_with_spec (
4097 get_identifier (PREFIX("caf_co_min"))(__builtin_constant_p ("_gfortran_" "caf_co_min") ? get_identifier_with_length
(("_gfortran_" "caf_co_min"), strlen ("_gfortran_" "caf_co_min"
)) : get_identifier ("_gfortran_" "caf_co_min")), ". w . w w . . ",
4098 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4099 pint_type, pchar_type_node, integer_type_nodeinteger_types[itk_int], size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4100
4101 gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec (
4102 get_identifier (PREFIX("caf_co_reduce"))(__builtin_constant_p ("_gfortran_" "caf_co_reduce") ? get_identifier_with_length
(("_gfortran_" "caf_co_reduce"), strlen ("_gfortran_" "caf_co_reduce"
)) : get_identifier ("_gfortran_" "caf_co_reduce")), ". w r . . w w . . ",
4103 void_type_nodeglobal_trees[TI_VOID_TYPE], 8, pvoid_type_node,
4104 build_pointer_type (build_varargs_function_type_list (void_type_nodeglobal_trees[TI_VOID_TYPE],
4105 NULL_TREE(tree) __null)),
4106 integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int], pint_type, pchar_type_node,
4107 integer_type_nodeinteger_types[itk_int], size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4108
4109 gfor_fndecl_co_sum = gfc_build_library_function_decl_with_spec (
4110 get_identifier (PREFIX("caf_co_sum"))(__builtin_constant_p ("_gfortran_" "caf_co_sum") ? get_identifier_with_length
(("_gfortran_" "caf_co_sum"), strlen ("_gfortran_" "caf_co_sum"
)) : get_identifier ("_gfortran_" "caf_co_sum")), ". w . w w . ",
4111 void_type_nodeglobal_trees[TI_VOID_TYPE], 5, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4112 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4113
4114 gfor_fndecl_caf_is_present = gfc_build_library_function_decl_with_spec (
4115 get_identifier (PREFIX("caf_is_present"))(__builtin_constant_p ("_gfortran_" "caf_is_present") ? get_identifier_with_length
(("_gfortran_" "caf_is_present"), strlen ("_gfortran_" "caf_is_present"
)) : get_identifier ("_gfortran_" "caf_is_present")), ". r . r ",
4116 integer_type_nodeinteger_types[itk_int], 3, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4117 pvoid_type_node);
4118
4119 gfor_fndecl_caf_random_init = gfc_build_library_function_decl (
4120 get_identifier (PREFIX("caf_random_init"))(__builtin_constant_p ("_gfortran_" "caf_random_init") ? get_identifier_with_length
(("_gfortran_" "caf_random_init"), strlen ("_gfortran_" "caf_random_init"
)) : get_identifier ("_gfortran_" "caf_random_init")),
4121 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, logical_type_node, logical_type_node);
4122 }
4123
4124 gfc_build_intrinsic_function_decls ();
4125 gfc_build_intrinsic_lib_fndecls ();
4126 gfc_build_io_library_fndecls ();
4127}
4128
4129
4130/* Evaluate the length of dummy character variables. */
4131
4132static void
4133gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl,
4134 gfc_wrapped_block *block)
4135{
4136 stmtblock_t init;
4137
4138 gfc_finish_decl (cl->backend_decl);
4139
4140 gfc_start_block (&init);
4141
4142 /* Evaluate the string length expression. */
4143 gfc_conv_string_length (cl, NULL__null, &init);
4144
4145 gfc_trans_vla_type_sizes (sym, &init);
4146
4147 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4148}
4149
4150
4151/* Allocate and cleanup an automatic character variable. */
4152
4153static void
4154gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
4155{
4156 stmtblock_t init;
4157 tree decl;
4158 tree tmp;
4159
4160 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4160, __FUNCTION__), 0 : 0));
4161 gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length)((void)(!(sym->ts.u.cl && sym->ts.u.cl->length
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4161, __FUNCTION__), 0 : 0));
4162
4163 gfc_init_block (&init);
4164
4165 /* Evaluate the string length expression. */
4166 gfc_conv_string_length (sym->ts.u.cl, NULL__null, &init);
4167
4168 gfc_trans_vla_type_sizes (sym, &init);
4169
4170 decl = sym->backend_decl;
4171
4172 /* Emit a DECL_EXPR for this variable, which will cause the
4173 gimplifier to allocate storage, and all that good stuff. */
4174 tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4174, __FUNCTION__))->typed.type), decl);
4175 gfc_add_expr_to_block (&init, tmp);
4176
4177 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4178}
4179
4180/* Set the initial value of ASSIGN statement auxiliary variable explicitly. */
4181
4182static void
4183gfc_trans_assign_aux_var (gfc_symbol * sym, gfc_wrapped_block * block)
4184{
4185 stmtblock_t init;
4186
4187 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4187, __FUNCTION__), 0 : 0));
4188 gfc_start_block (&init);
4189
4190 /* Set the initial value to length. See the comments in
4191 function gfc_add_assign_aux_vars in this file. */
4192 gfc_add_modify (&init, GFC_DECL_STRING_LEN (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4192, __FUNCTION__))->decl_common.lang_specific)->stringlen,
4193 build_int_cst (gfc_charlen_type_node, -2));
4194
4195 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4196}
4197
4198static void
4199gfc_trans_vla_one_sizepos (tree *tp, stmtblock_t *body)
4200{
4201 tree t = *tp, var, val;
4202
4203 if (t == NULL__null || t == error_mark_nodeglobal_trees[TI_ERROR_MARK])
4204 return;
4205 if (TREE_CONSTANT (t)((non_type_check ((t), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4205, __FUNCTION__))->base.constant_flag) || DECL_P (t)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code
) (t)->base.code))] == tcc_declaration))
4206 return;
4207
4208 if (TREE_CODE (t)((enum tree_code) (t)->base.code) == SAVE_EXPR)
4209 {
4210 if (SAVE_EXPR_RESOLVED_P (t)((tree_check ((t), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4210, __FUNCTION__, (SAVE_EXPR)))->base.public_flag))
4211 {
4212 *tp = TREE_OPERAND (t, 0)(*((const_cast<tree*> (tree_operand_check ((t), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4212, __FUNCTION__)))));
4213 return;
4214 }
4215 val = TREE_OPERAND (t, 0)(*((const_cast<tree*> (tree_operand_check ((t), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4215, __FUNCTION__)))));
4216 }
4217 else
4218 val = t;
4219
4220 var = gfc_create_var_np (TREE_TYPE (t)((contains_struct_check ((t), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4220, __FUNCTION__))->typed.type), NULL__null);
4221 gfc_add_decl_to_function (var);
4222 gfc_add_modify (body, var, unshare_expr (val));
4223 if (TREE_CODE (t)((enum tree_code) (t)->base.code) == SAVE_EXPR)
4224 TREE_OPERAND (t, 0)(*((const_cast<tree*> (tree_operand_check ((t), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4224, __FUNCTION__))))) = var;
4225 *tp = var;
4226}
4227
4228static void
4229gfc_trans_vla_type_sizes_1 (tree type, stmtblock_t *body)
4230{
4231 tree t;
4232
4233 if (type == NULL__null || type == error_mark_nodeglobal_trees[TI_ERROR_MARK])
4234 return;
4235
4236 type = TYPE_MAIN_VARIANT (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4236, __FUNCTION__))->type_common.main_variant);
4237
4238 if (TREE_CODE (type)((enum tree_code) (type)->base.code) == INTEGER_TYPE)
4239 {
4240 gfc_trans_vla_one_sizepos (&TYPE_MIN_VALUE (type)((tree_check5 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4240, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval
), body);
4241 gfc_trans_vla_one_sizepos (&TYPE_MAX_VALUE (type)((tree_check5 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4241, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
), body);
4242
4243 for (t = TYPE_NEXT_VARIANT (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4243, __FUNCTION__))->type_common.next_variant); t; t = TYPE_NEXT_VARIANT (t)((tree_class_check ((t), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4243, __FUNCTION__))->type_common.next_variant))
4244 {
4245 TYPE_MIN_VALUE (t)((tree_check5 ((t), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4245, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval
) = TYPE_MIN_VALUE (type)((tree_check5 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4245, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval
);
4246 TYPE_MAX_VALUE (t)((tree_check5 ((t), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4246, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
) = TYPE_MAX_VALUE (type)((tree_check5 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4246, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
);
4247 }
4248 }
4249 else if (TREE_CODE (type)((enum tree_code) (type)->base.code) == ARRAY_TYPE)
4250 {
4251 gfc_trans_vla_type_sizes_1 (TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4251, __FUNCTION__))->typed.type), body);
4252 gfc_trans_vla_type_sizes_1 (TYPE_DOMAIN (type)((tree_check ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4252, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
), body);
4253 gfc_trans_vla_one_sizepos (&TYPE_SIZE (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4253, __FUNCTION__))->type_common.size), body);
4254 gfc_trans_vla_one_sizepos (&TYPE_SIZE_UNIT (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4254, __FUNCTION__))->type_common.size_unit), body);
4255
4256 for (t = TYPE_NEXT_VARIANT (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4256, __FUNCTION__))->type_common.next_variant); t; t = TYPE_NEXT_VARIANT (t)((tree_class_check ((t), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4256, __FUNCTION__))->type_common.next_variant))
4257 {
4258 TYPE_SIZE (t)((tree_class_check ((t), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4258, __FUNCTION__))->type_common.size) = TYPE_SIZE (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4258, __FUNCTION__))->type_common.size);
4259 TYPE_SIZE_UNIT (t)((tree_class_check ((t), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4259, __FUNCTION__))->type_common.size_unit) = TYPE_SIZE_UNIT (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4259, __FUNCTION__))->type_common.size_unit);
4260 }
4261 }
4262}
4263
4264/* Make sure all type sizes and array domains are either constant,
4265 or variable or parameter decls. This is a simplified variant
4266 of gimplify_type_sizes, but we can't use it here, as none of the
4267 variables in the expressions have been gimplified yet.
4268 As type sizes and domains for various variable length arrays
4269 contain VAR_DECLs that are only initialized at gfc_trans_deferred_vars
4270 time, without this routine gimplify_type_sizes in the middle-end
4271 could result in the type sizes being gimplified earlier than where
4272 those variables are initialized. */
4273
4274void
4275gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
4276{
4277 tree type = TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4277, __FUNCTION__))->typed.type);
4278
4279 if (TREE_CODE (type)((enum tree_code) (type)->base.code) == FUNCTION_TYPE
4280 && (sym->attr.function || sym->attr.result || sym->attr.entry))
4281 {
4282 if (! current_fake_result_decl)
4283 return;
4284
4285 type = TREE_TYPE (TREE_VALUE (current_fake_result_decl))((contains_struct_check ((((tree_check ((current_fake_result_decl
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4285, __FUNCTION__, (TREE_LIST)))->list.value)), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4285, __FUNCTION__))->typed.type);
4286 }
4287
4288 while (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE))
4289 type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4289, __FUNCTION__))->typed.type);
4290
4291 if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4291, __FUNCTION__))->type_common.lang_flag_1))
4292 {
4293 tree etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4293, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type);
4294
4295 while (POINTER_TYPE_P (etype)(((enum tree_code) (etype)->base.code) == POINTER_TYPE || (
(enum tree_code) (etype)->base.code) == REFERENCE_TYPE))
4296 etype = TREE_TYPE (etype)((contains_struct_check ((etype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4296, __FUNCTION__))->typed.type);
4297
4298 gfc_trans_vla_type_sizes_1 (etype, body);
4299 }
4300
4301 gfc_trans_vla_type_sizes_1 (type, body);
4302}
4303
4304
4305/* Initialize a derived type by building an lvalue from the symbol
4306 and using trans_assignment to do the work. Set dealloc to false
4307 if no deallocation prior the assignment is needed. */
4308void
4309gfc_init_default_dt (gfc_symbol * sym, stmtblock_t * block, bool dealloc)
4310{
4311 gfc_expr *e;
4312 tree tmp;
4313 tree present;
4314
4315 gcc_assert (block)((void)(!(block) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4315, __FUNCTION__), 0 : 0));
4316
4317 /* Initialization of PDTs is done elsewhere. */
4318 if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_type)
4319 return;
4320
4321 gcc_assert (!sym->attr.allocatable)((void)(!(!sym->attr.allocatable) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4321, __FUNCTION__), 0 : 0));
4322 gfc_set_sym_referenced (sym);
4323 e = gfc_lval_expr_from_sym (sym);
4324 tmp = gfc_trans_assignment (e, sym->value, false, dealloc);
4325 if (sym->attr.dummy && (sym->attr.optional
4326 || sym->ns->proc_name->attr.entry_master))
4327 {
4328 present = gfc_conv_expr_present (sym);
4329 tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4329, __FUNCTION__))->typed.type), present,
4330 tmp, build_empty_stmt (input_location));
4331 }
4332 gfc_add_expr_to_block (block, tmp);
4333 gfc_free_expr (e);
4334}
4335
4336
4337/* Initialize INTENT(OUT) derived type dummies. As well as giving
4338 them their default initializer, if they do not have allocatable
4339 components, they have their allocatable components deallocated. */
4340
4341static void
4342init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
4343{
4344 stmtblock_t init;
4345 gfc_formal_arglist *f;
4346 tree tmp;
4347 tree present;
4348 gfc_symbol *s;
4349 bool dealloc_with_value = false;
4350
4351 gfc_init_block (&init);
4352 for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
4353 if (f->sym && f->sym->attr.intent == INTENT_OUT
4354 && !f->sym->attr.pointer
4355 && f->sym->ts.type == BT_DERIVED)
4356 {
4357 s = f->sym;
4358 tmp = NULL_TREE(tree) __null;
4359
4360 /* Note: Allocatables are excluded as they are already handled
4361 by the caller. */
4362 if (!f->sym->attr.allocatable
4363 && gfc_is_finalizable (s->ts.u.derived, NULL__null))
4364 {
4365 stmtblock_t block;
4366 gfc_expr *e;
4367
4368 gfc_init_block (&block);
4369 s->attr.referenced = 1;
4370 e = gfc_lval_expr_from_sym (s);
4371 gfc_add_finalizer_call (&block, e);
4372 gfc_free_expr (e);
4373 tmp = gfc_finish_block (&block);
4374 }
4375
4376 /* Note: Allocatables are excluded as they are already handled
4377 by the caller. */
4378 if (tmp == NULL_TREE(tree) __null && !s->attr.allocatable
4379 && s->ts.u.derived->attr.alloc_comp)
4380 {
4381 tmp = gfc_deallocate_alloc_comp (s->ts.u.derived,
4382 s->backend_decl,
4383 s->as ? s->as->rank : 0);
4384 dealloc_with_value = s->value;
4385 }
4386
4387 if (tmp != NULL_TREE(tree) __null && (s->attr.optional
4388 || s->ns->proc_name->attr.entry_master))
4389 {
4390 present = gfc_conv_expr_present (s);
4391 tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4391, __FUNCTION__))->typed.type),
4392 present, tmp, build_empty_stmt (input_location));
4393 }
4394
4395 if (tmp != NULL_TREE(tree) __null && !dealloc_with_value)
4396 gfc_add_expr_to_block (&init, tmp);
4397 else if (s->value && !s->attr.allocatable)
4398 {
4399 gfc_add_expr_to_block (&init, tmp);
4400 gfc_init_default_dt (s, &init, false);
4401 dealloc_with_value = false;
4402 }
4403 }
4404 else if (f->sym && f->sym->attr.intent == INTENT_OUT
4405 && f->sym->ts.type == BT_CLASS
4406 && !CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.class_pointer
4407 && !CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.allocatable)
4408 {
4409 stmtblock_t block;
4410 gfc_expr *e;
4411
4412 gfc_init_block (&block);
4413 f->sym->attr.referenced = 1;
4414 e = gfc_lval_expr_from_sym (f->sym);
4415 gfc_add_finalizer_call (&block, e);
4416 gfc_free_expr (e);
4417 tmp = gfc_finish_block (&block);
4418
4419 if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master)
4420 {
4421 present = gfc_conv_expr_present (f->sym);
4422 tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4422, __FUNCTION__))->typed.type),
4423 present, tmp,
4424 build_empty_stmt (input_location));
4425 }
4426 gfc_add_expr_to_block (&init, tmp);
4427 }
4428 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4429}
4430
4431
4432/* Helper function to manage deferred string lengths. */
4433
4434static tree
4435gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init,
4436 locus *loc)
4437{
4438 tree tmp;
4439
4440 /* Character length passed by reference. */
4441 tmp = sym->ts.u.cl->passed_length;
4442 tmp = build_fold_indirect_ref_loc (input_location, tmp);
4443 tmp = fold_convert (gfc_charlen_type_node, tmp)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, tmp
);
4444
4445 if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
4446 /* Zero the string length when entering the scope. */
4447 gfc_add_modify (init, sym->ts.u.cl->backend_decl,
4448 build_int_cst (gfc_charlen_type_node, 0));
4449 else
4450 {
4451 tree tmp2;
4452
4453 tmp2 = fold_build2_loc (input_location, MODIFY_EXPR,
4454 gfc_charlen_type_node,
4455 sym->ts.u.cl->backend_decl, tmp);
4456 if (sym->attr.optional)
4457 {
4458 tree present = gfc_conv_expr_present (sym);
4459 tmp2 = build3_loc (input_location, COND_EXPR,
4460 void_type_nodeglobal_trees[TI_VOID_TYPE], present, tmp2,
4461 build_empty_stmt (input_location));
4462 }
4463 gfc_add_expr_to_block (init, tmp2);
4464 }
4465
4466 gfc_restore_backend_locus (loc);
4467
4468 /* Pass the final character length back. */
4469 if (sym->attr.intent != INTENT_IN)
4470 {
4471 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
4472 gfc_charlen_type_node, tmp,
4473 sym->ts.u.cl->backend_decl);
4474 if (sym->attr.optional)
4475 {
4476 tree present = gfc_conv_expr_present (sym);
4477 tmp = build3_loc (input_location, COND_EXPR,
4478 void_type_nodeglobal_trees[TI_VOID_TYPE], present, tmp,
4479 build_empty_stmt (input_location));
4480 }
4481 }
4482 else
4483 tmp = NULL_TREE(tree) __null;
4484
4485 return tmp;
4486}
4487
4488
4489/* Get the result expression for a procedure. */
4490
4491static tree
4492get_proc_result (gfc_symbol* sym)
4493{
4494 if (sym->attr.subroutine || sym == sym->result)
4495 {
4496 if (current_fake_result_decl != NULL__null)
4497 return TREE_VALUE (current_fake_result_decl)((tree_check ((current_fake_result_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4497, __FUNCTION__, (TREE_LIST)))->list.value);
4498
4499 return NULL_TREE(tree) __null;
4500 }
4501
4502 return sym->result->backend_decl;
4503}
4504
4505
4506/* Generate function entry and exit code, and add it to the function body.
4507 This includes:
4508 Allocation and initialization of array variables.
4509 Allocation of character string variables.
4510 Initialization and possibly repacking of dummy arrays.
4511 Initialization of ASSIGN statement auxiliary variable.
4512 Initialization of ASSOCIATE names.
4513 Automatic deallocation. */
4514
4515void
4516gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
4517{
4518 locus loc;
4519 gfc_symbol *sym;
4520 gfc_formal_arglist *f;
4521 stmtblock_t tmpblock;
4522 bool seen_trans_deferred_array = false;
4523 bool is_pdt_type = false;
4524 tree tmp = NULL__null;
4525 gfc_expr *e;
4526 gfc_se se;
4527 stmtblock_t init;
4528
4529 /* Deal with implicit return variables. Explicit return variables will
4530 already have been added. */
4531 if (gfc_return_by_reference (proc_sym) && proc_sym->result == proc_sym)
1
Assuming the condition is false
→
4532 {
4533 if (!current_fake_result_decl)
4534 {
4535 gfc_entry_list *el = NULL__null;
4536 if (proc_sym->attr.entry_master)
4537 {
4538 for (el = proc_sym->ns->entries; el; el = el->next)
4539 if (el->sym != el->sym->result)
4540 break;
4541 }
4542 /* TODO: move to the appropriate place in resolve.cc. */
4543 if (warn_return_typeglobal_options.x_warn_return_type > 0 && el == NULL__null)
4544 gfc_warning (OPT_Wreturn_type,
4545 "Return value of function %qs at %L not set",
4546 proc_sym->name, &proc_sym->declared_at);
4547 }
4548 else if (proc_sym->as)
4549 {
4550 tree result = TREE_VALUE (current_fake_result_decl)((tree_check ((current_fake_result_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4550, __FUNCTION__, (TREE_LIST)))->list.value);
4551 gfc_save_backend_locus (&loc);
4552 gfc_set_backend_locus (&proc_sym->declared_at);
4553 gfc_trans_dummy_array_bias (proc_sym, result, block);
4554
4555 /* An automatic character length, pointer array result. */
4556 if (proc_sym->ts.type == BT_CHARACTER
4557 && VAR_P (proc_sym->ts.u.cl->backend_decl)(((enum tree_code) (proc_sym->ts.u.cl->backend_decl)->
base.code) == VAR_DECL))
4558 {
4559 tmp = NULL__null;
4560 if (proc_sym->ts.deferred)
4561 {
4562 gfc_start_block (&init);
4563 tmp = gfc_null_and_pass_deferred_len (proc_sym, &init, &loc);
4564 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
4565 }
4566 else
4567 gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
4568 }
4569 }
4570 else if (proc_sym->ts.type == BT_CHARACTER)
4571 {
4572 if (proc_sym->ts.deferred)
4573 {
4574 tmp = NULL__null;
4575 gfc_save_backend_locus (&loc);
4576 gfc_set_backend_locus (&proc_sym->declared_at);
4577 gfc_start_block (&init);
4578 /* Zero the string length on entry. */
4579 gfc_add_modify (&init, proc_sym->ts.u.cl->backend_decl,
4580 build_int_cst (gfc_charlen_type_node, 0));
4581 /* Null the pointer. */
4582 e = gfc_lval_expr_from_sym (proc_sym);
4583 gfc_init_se (&se, NULL__null);
4584 se.want_pointer = 1;
4585 gfc_conv_expr (&se, e);
4586 gfc_free_expr (e);
4587 tmp = se.expr;
4588 gfc_add_modify (&init, tmp,
4589 fold_convert (TREE_TYPE (se.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4589, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
])
4590 null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4589, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
]));
4591 gfc_restore_backend_locus (&loc);
4592
4593 /* Pass back the string length on exit. */
4594 tmp = proc_sym->ts.u.cl->backend_decl;
4595 if (TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) != INDIRECT_REF
4596 && proc_sym->ts.u.cl->passed_length)
4597 {
4598 tmp = proc_sym->ts.u.cl->passed_length;
4599 tmp = build_fold_indirect_ref_loc (input_location, tmp);
4600 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
4601 TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4601, __FUNCTION__))->typed.type), tmp,
4602 fold_convertfold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4603, __FUNCTION__))->typed.type), proc_sym->ts.u.cl->
backend_decl)
4603 (TREE_TYPE (tmp),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4603, __FUNCTION__))->typed.type), proc_sym->ts.u.cl->
backend_decl)
4604 proc_sym->ts.u.cl->backend_decl)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4603, __FUNCTION__))->typed.type), proc_sym->ts.u.cl->
backend_decl));
4605 }
4606 else
4607 tmp = NULL_TREE(tree) __null;
4608
4609 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
4610 }
4611 else if (VAR_P (proc_sym->ts.u.cl->backend_decl)(((enum tree_code) (proc_sym->ts.u.cl->backend_decl)->
base.code) == VAR_DECL))
4612 gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
4613 }
4614 else
4615 gcc_assert (flag_f2c && proc_sym->ts.type == BT_COMPLEX)((void)(!(global_options.x_flag_f2c && proc_sym->ts
.type == BT_COMPLEX) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4615, __FUNCTION__), 0 : 0));
4616 }
4617 else if (proc_sym == proc_sym->result && IS_CLASS_ARRAY (proc_sym)(proc_sym->ts.type == BT_CLASS && proc_sym->ts.
u.derived->components && proc_sym->ts.u.derived
->components->attr.dimension && !proc_sym->ts
.u.derived->components->attr.class_pointer))
2
←
Assuming 'proc_sym' is not equal to field 'result'
→
4618 {
4619 /* Nullify explicit return class arrays on entry. */
4620 tree type;
4621 tmp = get_proc_result (proc_sym);
4622 if (tmp && GFC_CLASS_TYPE_P (TREE_TYPE (tmp))((tree_class_check ((((contains_struct_check ((tmp), (TS_TYPED
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4622, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4622, __FUNCTION__))->type_common.lang_flag_4))
4623 {
4624 gfc_start_block (&init);
4625 tmp = gfc_class_data_get (tmp);
4626 type = TREE_TYPE (gfc_conv_descriptor_data_get (tmp))((contains_struct_check ((gfc_conv_descriptor_data_get (tmp))
, (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4626, __FUNCTION__))->typed.type);
4627 gfc_conv_descriptor_data_set (&init, tmp, build_int_cst (type, 0));
4628 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4629 }
4630 }
4631
4632
4633 /* Initialize the INTENT(OUT) derived type dummy arguments. This
4634 should be done here so that the offsets and lbounds of arrays
4635 are available. */
4636 gfc_save_backend_locus (&loc);
4637 gfc_set_backend_locus (&proc_sym->declared_at);
4638 init_intent_out_dt (proc_sym, block);
4639 gfc_restore_backend_locus (&loc);
4640
4641 for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
3
←
Assuming 'sym' is not equal to 'proc_sym'
→
4642 {
4643 bool alloc_comp_or_fini = (sym->ts.type == BT_DERIVED)
4
←
Assuming field 'type' is not equal to BT_DERIVED
→
4644 && (sym->ts.u.derived->attr.alloc_comp
4645 || gfc_is_finalizable (sym->ts.u.derived,
4646 NULL__null));
4647 if (sym->assoc)
5
←
Assuming field 'assoc' is null
→
4648 continue;
4649
4650 if (sym->ts.type
5.1
Field 'type' is not equal to BT_DERIVED
 == BT_DERIVED
4651 && sym->ts.u.derived
4652 && sym->ts.u.derived->attr.pdt_type)
4653 {
4654 is_pdt_type = true;
4655 gfc_init_block (&tmpblock);
4656 if (!(sym->attr.dummy
4657 || sym->attr.pointer
4658 || sym->attr.allocatable))
4659 {
4660 tmp = gfc_allocate_pdt_comp (sym->ts.u.derived,
4661 sym->backend_decl,
4662 sym->as ? sym->as->rank : 0,
4663 sym->param_list);
4664 gfc_add_expr_to_block (&tmpblock, tmp);
4665 if (!sym->attr.result)
4666 tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived,
4667 sym->backend_decl,
4668 sym->as ? sym->as->rank : 0);
4669 else
4670 tmp = NULL_TREE(tree) __null;
4671 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp);
4672 }
4673 else if (sym->attr.dummy)
4674 {
4675 tmp = gfc_check_pdt_dummy (sym->ts.u.derived,
4676 sym->backend_decl,
4677 sym->as ? sym->as->rank : 0,
4678 sym->param_list);
4679 gfc_add_expr_to_block (&tmpblock, tmp);
4680 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL__null);
4681 }
4682 }
4683 else if (sym->ts.type == BT_CLASS
6
←
Assuming field 'type' is not equal to BT_CLASS
→
4684 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived
4685 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived->attr.pdt_type)
4686 {
4687 gfc_component *data = CLASS_DATA (sym)sym->ts.u.derived->components;
4688 is_pdt_type = true;
4689 gfc_init_block (&tmpblock);
4690 if (!(sym->attr.dummy
4691 || CLASS_DATA (sym)sym->ts.u.derived->components->attr.pointer
4692 || CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable))
4693 {
4694 tmp = gfc_class_data_get (sym->backend_decl);
4695 tmp = gfc_allocate_pdt_comp (data->ts.u.derived, tmp,
4696 data->as ? data->as->rank : 0,
4697 sym->param_list);
4698 gfc_add_expr_to_block (&tmpblock, tmp);
4699 tmp = gfc_class_data_get (sym->backend_decl);
4700 if (!sym->attr.result)
4701 tmp = gfc_deallocate_pdt_comp (data->ts.u.derived, tmp,
4702 data->as ? data->as->rank : 0);
4703 else
4704 tmp = NULL_TREE(tree) __null;
4705 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp);
4706 }
4707 else if (sym->attr.dummy)
4708 {
4709 tmp = gfc_class_data_get (sym->backend_decl);
4710 tmp = gfc_check_pdt_dummy (data->ts.u.derived, tmp,
4711 data->as ? data->as->rank : 0,
4712 sym->param_list);
4713 gfc_add_expr_to_block (&tmpblock, tmp);
4714 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL__null);
4715 }
4716 }
4717
4718 if (sym->attr.pointer && sym->attr.dimension
7
←
Assuming field 'pointer' is 0
→
4719 && sym->attr.save == SAVE_NONE
4720 && !sym->attr.use_assoc
4721 && !sym->attr.host_assoc
4722 && !sym->attr.dummy
4723 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl))((tree_class_check ((((contains_struct_check ((sym->backend_decl
), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4723, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4723, __FUNCTION__))->type_common.lang_flag_1))
4724 {
4725 gfc_init_block (&tmpblock);
4726 gfc_conv_descriptor_span_set (&tmpblock, sym->backend_decl,
4727 build_int_cst (gfc_array_index_type, 0));
4728 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
4729 NULL_TREE(tree) __null);
4730 }
4731
4732 if (sym->ts.type
7.1
Field 'type' is not equal to BT_CLASS
 == BT_CLASS
4733 && (sym->attr.save || flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == 0)
4734 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable)
4735 {
4736 tree vptr;
4737
4738 if (UNLIMITED_POLY (sym)(sym != __null && sym->ts.type == BT_CLASS &&
sym->ts.u.derived->components && sym->ts.u.
derived->components->ts.u.derived && sym->ts
.u.derived->components->ts.u.derived->attr.unlimited_polymorphic
))
4739 vptr = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
4740 else
4741 {
4742 gfc_symbol *vsym;
4743 vsym = gfc_find_derived_vtab (sym->ts.u.derived);
4744 vptr = gfc_get_symbol_decl (vsym);
4745 vptr = gfc_build_addr_expr (NULL__null, vptr);
4746 }
4747
4748 if (CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
4749 || (CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension
4750 && flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB))
4751 {
4752 tmp = gfc_class_data_get (sym->backend_decl);
4753 tmp = gfc_build_null_descriptor (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4753, __FUNCTION__))->typed.type));
4754 }
4755 else
4756 tmp = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
4757
4758 DECL_INITIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4758, __FUNCTION__))->decl_common.initial)
4759 = gfc_class_set_static_fields (sym->backend_decl, vptr, tmp);
4760 TREE_CONSTANT (DECL_INITIAL (sym->backend_decl))((non_type_check ((((contains_struct_check ((sym->backend_decl
), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4760, __FUNCTION__))->decl_common.initial)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4760, __FUNCTION__))->base.constant_flag) = 1;
4761 }
4762 else if ((sym->attr.dimension || sym->attr.codimension
8
←
Assuming field 'dimension' is 0
→
9
←
Assuming field 'codimension' is 0
→
4763 || (IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer) && !CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable)))
4764 {
4765 bool is_classarray = IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer);
4766 symbol_attribute *array_attr;
4767 gfc_array_spec *as;
4768 array_type type_of_array;
4769
4770 array_attr = is_classarray ? &CLASS_DATA (sym)sym->ts.u.derived->components->attr : &sym->attr;
4771 as = is_classarray ? CLASS_DATA (sym)sym->ts.u.derived->components->as : sym->as;
4772 /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT. */
4773 type_of_array = as->type;
4774 if (type_of_array == AS_ASSUMED_SIZE && as->cp_was_assumed)
4775 type_of_array = AS_EXPLICIT;
4776 switch (type_of_array)
4777 {
4778 case AS_EXPLICIT:
4779 if (sym->attr.dummy || sym->attr.result)
4780 gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
4781 /* Allocatable and pointer arrays need to processed
4782 explicitly. */
4783 else if ((sym->ts.type != BT_CLASS && sym->attr.pointer)
4784 || (sym->ts.type == BT_CLASS
4785 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer)
4786 || array_attr->allocatable)
4787 {
4788 if (TREE_STATIC (sym->backend_decl)((sym->backend_decl)->base.static_flag))
4789 {
4790 gfc_save_backend_locus (&loc);
4791 gfc_set_backend_locus (&sym->declared_at);
4792 gfc_trans_static_array_pointer (sym);
4793 gfc_restore_backend_locus (&loc);
4794 }
4795 else
4796 {
4797 seen_trans_deferred_array = true;
4798 gfc_trans_deferred_array (sym, block);
4799 }
4800 }
4801 else if (sym->attr.codimension
4802 && TREE_STATIC (sym->backend_decl)((sym->backend_decl)->base.static_flag))
4803 {
4804 gfc_init_block (&tmpblock);
4805 gfc_trans_array_cobounds (TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4805, __FUNCTION__))->typed.type),
4806 &tmpblock, sym);
4807 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
4808 NULL_TREE(tree) __null);
4809 continue;
4810 }
4811 else
4812 {
4813 gfc_save_backend_locus (&loc);
4814 gfc_set_backend_locus (&sym->declared_at);
4815
4816 if (alloc_comp_or_fini)
4817 {
4818 seen_trans_deferred_array = true;
4819 gfc_trans_deferred_array (sym, block);
4820 }
4821 else if (sym->ts.type == BT_DERIVED
4822 && sym->value
4823 && !sym->attr.data
4824 && sym->attr.save == SAVE_NONE)
4825 {
4826 gfc_start_block (&tmpblock);
4827 gfc_init_default_dt (sym, &tmpblock, false);
4828 gfc_add_init_cleanup (block,
4829 gfc_finish_block (&tmpblock),
4830 NULL_TREE(tree) __null);
4831 }
4832
4833 gfc_trans_auto_array_allocation (sym->backend_decl,
4834 sym, block);
4835 gfc_restore_backend_locus (&loc);
4836 }
4837 break;
4838
4839 case AS_ASSUMED_SIZE:
4840 /* Must be a dummy parameter. */
4841 gcc_assert (sym->attr.dummy || as->cp_was_assumed)((void)(!(sym->attr.dummy || as->cp_was_assumed) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4841, __FUNCTION__), 0 : 0));
4842
4843 /* We should always pass assumed size arrays the g77 way. */
4844 if (sym->attr.dummy)
4845 gfc_trans_g77_array (sym, block);
4846 break;
4847
4848 case AS_ASSUMED_SHAPE:
4849 /* Must be a dummy parameter. */
4850 gcc_assert (sym->attr.dummy)((void)(!(sym->attr.dummy) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4850, __FUNCTION__), 0 : 0));
4851
4852 gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
4853 break;
4854
4855 case AS_ASSUMED_RANK:
4856 case AS_DEFERRED:
4857 seen_trans_deferred_array = true;
4858 gfc_trans_deferred_array (sym, block);
4859 if (sym->ts.type == BT_CHARACTER && sym->ts.deferred
4860 && sym->attr.result)
4861 {
4862 gfc_start_block (&init);
4863 gfc_save_backend_locus (&loc);
4864 gfc_set_backend_locus (&sym->declared_at);
4865 tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
4866 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
4867 }
4868 break;
4869
4870 default:
4871 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4871, __FUNCTION__));
4872 }
4873 if (alloc_comp_or_fini && !seen_trans_deferred_array)
4874 gfc_trans_deferred_array (sym, block);
4875 }
4876 else if ((!sym->attr.dummy || sym->ts.deferred)
10
←
Assuming field 'dummy' is not equal to 0
→
11
←
Assuming field 'deferred' is true
→
4877 && (sym->ts.type
11.1
Field 'type' is not equal to BT_CLASS
 == BT_CLASS
4878 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer))
4879 gfc_trans_class_array (sym, block);
4880 else if ((!sym->attr.dummy
11.2
Field 'dummy' is not equal to 0
 || sym->ts.deferred
11.3
Field 'deferred' is true
)
4881 && (sym->attr.allocatable
12
←
Assuming field 'allocatable' is not equal to 0
→
4882 || (sym->attr.pointer && sym->attr.result)
4883 || (sym->ts.type == BT_CLASS
4884 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable)))
4885 {
4886 if (!sym->attr.save && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != 0)
13
←
Assuming field 'save' is 0
→
14
←
Assuming field 'x_flag_max_stack_var_size' is not equal to 0
→
15
←
Taking true branch
→
4887 {
4888 tree descriptor = NULL_TREE(tree) __null;
4889
4890 gfc_save_backend_locus (&loc);
4891 gfc_set_backend_locus (&sym->declared_at);
4892 gfc_start_block (&init);
4893
4894 if (sym->ts.type == BT_CHARACTER
16
←
Assuming field 'type' is not equal to BT_CHARACTER
→
4895 && sym->attr.allocatable
4896 && !sym->attr.dimension
4897 && sym->ts.u.cl && sym->ts.u.cl->length
4898 && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE)
4899 gfc_conv_string_length (sym->ts.u.cl, NULL__null, &init);
4900
4901 if (!sym->attr.pointer)
17
←
Assuming field 'pointer' is not equal to 0
→
4902 {
4903 /* Nullify and automatic deallocation of allocatable
4904 scalars. */
4905 e = gfc_lval_expr_from_sym (sym);
4906 if (sym->ts.type == BT_CLASS)
4907 gfc_add_data_component (e)gfc_add_component_ref(e,"_data");
4908
4909 gfc_init_se (&se, NULL__null);
4910 if (sym->ts.type != BT_CLASS
4911 || sym->ts.u.derived->attr.dimension
4912 || sym->ts.u.derived->attr.codimension)
4913 {
4914 se.want_pointer = 1;
4915 gfc_conv_expr (&se, e);
4916 }
4917 else if (sym->ts.type == BT_CLASS
4918 && !CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
4919 && !CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension)
4920 {
4921 se.want_pointer = 1;
4922 gfc_conv_expr (&se, e);
4923 }
4924 else
4925 {
4926 se.descriptor_only = 1;
4927 gfc_conv_expr (&se, e);
4928 descriptor = se.expr;
4929 se.expr = gfc_conv_descriptor_data_addr (se.expr);
4930 se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
4931 }
4932 gfc_free_expr (e);
4933
4934 if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
4935 {
4936 /* Nullify when entering the scope. */
4937 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
4938 TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4938, __FUNCTION__))->typed.type), se.expr,
4939 fold_convert (TREE_TYPE (se.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4939, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
])
4940 null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 4939, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
]));
4941 if (sym->attr.optional)
4942 {
4943 tree present = gfc_conv_expr_present (sym);
4944 tmp = build3_loc (input_location, COND_EXPR,
4945 void_type_nodeglobal_trees[TI_VOID_TYPE], present, tmp,
4946 build_empty_stmt (input_location));
4947 }
4948 gfc_add_expr_to_block (&init, tmp);
4949 }
4950 }
4951
4952 if ((sym->attr.dummy || sym->attr.result)
18
←
Assuming field 'dummy' is 0
→
19
←
Assuming field 'result' is 0
→
4953 && sym->ts.type == BT_CHARACTER
4954 && sym->ts.deferred
4955 && sym->ts.u.cl->passed_length)
4956 tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
4957 else
4958 {
4959 gfc_restore_backend_locus (&loc);
4960 tmp = NULL_TREE(tree) __null;
4961 }
4962
4963 /* Initialize descriptor's TKR information. */
4964 if (sym->ts.type == BT_CLASS)
20
←
Assuming field 'type' is equal to BT_CLASS
→
21
←
Taking true branch
→
4965 gfc_trans_class_array (sym, block);
4966
4967 /* Deallocate when leaving the scope. Nullifying is not
4968 needed. */
4969 if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer
22
←
Assuming field 'result' is 0
→
23
←
Assuming field 'dummy' is 0
→
24
←
Assuming field 'pointer' is 0
→
4970 && !sym->ns->proc_name->attr.is_main_program)
25
←
Assuming field 'is_main_program' is 0
→
4971 {
4972 if (sym->ts.type == BT_CLASS
26
←
Assuming field 'type' is not equal to BT_CLASS
→
4973 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension)
4974 tmp = gfc_deallocate_with_status (descriptor, NULL_TREE(tree) __null,
4975 NULL_TREE(tree) __null, NULL_TREE(tree) __null,
4976 NULL_TREE(tree) __null, true, NULL__null,
4977 GFC_CAF_COARRAY_ANALYZE);
4978 else
4979 {
4980 gfc_expr *expr = gfc_lval_expr_from_sym (sym);
4981 tmp = gfc_deallocate_scalar_with_status (se.expr,
27
←
1st function call argument is an uninitialized value
4982 NULL_TREE(tree) __null,
4983 NULL_TREE(tree) __null,
4984 true, expr,
4985 sym->ts);
4986 gfc_free_expr (expr);
4987 }
4988 }
4989
4990 if (sym->ts.type == BT_CLASS)
4991 {
4992 /* Initialize _vptr to declared type. */
4993 gfc_symbol *vtab;
4994 tree rhs;
4995
4996 gfc_save_backend_locus (&loc);
4997 gfc_set_backend_locus (&sym->declared_at);
4998 e = gfc_lval_expr_from_sym (sym);
4999 gfc_add_vptr_component (e)gfc_add_component_ref(e,"_vptr");
5000 gfc_init_se (&se, NULL__null);
5001 se.want_pointer = 1;
5002 gfc_conv_expr (&se, e);
5003 gfc_free_expr (e);
5004 if (UNLIMITED_POLY (sym)(sym != __null && sym->ts.type == BT_CLASS &&
sym->ts.u.derived->components && sym->ts.u.
derived->components->ts.u.derived && sym->ts
.u.derived->components->ts.u.derived->attr.unlimited_polymorphic
))
5005 rhs = build_int_cst (TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 5005, __FUNCTION__))->typed.type), 0);
5006 else
5007 {
5008 vtab = gfc_find_derived_vtab (sym->ts.u.derived);
5009 rhs = gfc_build_addr_expr (TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.cc"
, 5009, __FUNCTION__))->typed.type),
5010 gfc_get_symbol_decl (vtab));
5011 }
5012 gfc_add_modify (&init, se.expr, rhs);
5013 gfc_restore_backend_locus (&loc);
5014 }
5015
5016 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
5017 }
5018 }