Bug Summary

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

Annotated Source Code

Press '?' to see keyboard shortcuts

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