/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc

Bug Summary

File:	build/gcc/fortran/trans-array.cc
Warning:	line 7587, column 7 Although the value stored to 'arg' is used in the enclosing expression, the value is never actually read from 'arg'

Annotated Source Code

Press '?' to see keyboard shortcuts

Show analyzer invocation

clang -cc1 -cc1 -triple x86_64-suse-linux -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name trans-array.cc -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/15.0.7 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/backward -internal-isystem /usr/lib64/clang/15.0.7/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2023-03-27-141847-20772-1/report-Z2LYPj.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc

1	/* Array translation routines
2	Copyright (C) 2002-2023 Free Software Foundation, Inc.
3	Contributed by Paul Brook <paul@nowt.org>
4	and Steven Bosscher <s.bosscher@student.tudelft.nl>
5
6	This file is part of GCC.
7
8	GCC is free software; you can redistribute it and/or modify it under
9	the terms of the GNU General Public License as published by the Free
10	Software Foundation; either version 3, or (at your option) any later
11	version.
12
13	GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14	WARRANTY; without even the implied warranty of MERCHANTABILITY or
15	FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16	for more details.
17
18	You should have received a copy of the GNU General Public License
19	along with GCC; see the file COPYING3. If not see
20	<http://www.gnu.org/licenses/>. */
21
22	/* trans-array.cc-- Various array related code, including scalarization,
23	allocation, initialization and other support routines. */
24
25	/* How the scalarizer works.
26	In gfortran, array expressions use the same core routines as scalar
27	expressions.
28	First, a Scalarization State (SS) chain is built. This is done by walking
29	the expression tree, and building a linear list of the terms in the
30	expression. As the tree is walked, scalar subexpressions are translated.
31
32	The scalarization parameters are stored in a gfc_loopinfo structure.
33	First the start and stride of each term is calculated by
34	gfc_conv_ss_startstride. During this process the expressions for the array
35	descriptors and data pointers are also translated.
36
37	If the expression is an assignment, we must then resolve any dependencies.
38	In Fortran all the rhs values of an assignment must be evaluated before
39	any assignments take place. This can require a temporary array to store the
40	values. We also require a temporary when we are passing array expressions
41	or vector subscripts as procedure parameters.
42
43	Array sections are passed without copying to a temporary. These use the
44	scalarizer to determine the shape of the section. The flag
45	loop->array_parameter tells the scalarizer that the actual values and loop
46	variables will not be required.
47
48	The function gfc_conv_loop_setup generates the scalarization setup code.
49	It determines the range of the scalarizing loop variables. If a temporary
50	is required, this is created and initialized. Code for scalar expressions
51	taken outside the loop is also generated at this time. Next the offset and
52	scaling required to translate from loop variables to array indices for each
53	term is calculated.
54
55	A call to gfc_start_scalarized_body marks the start of the scalarized
56	expression. This creates a scope and declares the loop variables. Before
57	calling this gfc_make_ss_chain_used must be used to indicate which terms
58	will be used inside this loop.
59
60	The scalar gfc_conv_* functions are then used to build the main body of the
61	scalarization loop. Scalarization loop variables and precalculated scalar
62	values are automatically substituted. Note that gfc_advance_se_ss_chain
63	must be used, rather than changing the se->ss directly.
64
65	For assignment expressions requiring a temporary two sub loops are
66	generated. The first stores the result of the expression in the temporary,
67	the second copies it to the result. A call to
68	gfc_trans_scalarized_loop_boundary marks the end of the main loop code and
69	the start of the copying loop. The temporary may be less than full rank.
70
71	Finally gfc_trans_scalarizing_loops is called to generate the implicit do
72	loops. The loops are added to the pre chain of the loopinfo. The post
73	chain may still contain cleanup code.
74
75	After the loop code has been added into its parent scope gfc_cleanup_loop
76	is called to free all the SS allocated by the scalarizer. */
77
78	#include "config.h"
79	#include "system.h"
80	#include "coretypes.h"
81	#include "options.h"
82	#include "tree.h"
83	#include "gfortran.h"
84	#include "gimple-expr.h"
85	#include "trans.h"
86	#include "fold-const.h"
87	#include "constructor.h"
88	#include "trans-types.h"
89	#include "trans-array.h"
90	#include "trans-const.h"
91	#include "dependency.h"
92
93	static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
94
95	/* The contents of this structure aren't actually used, just the address. */
96	static gfc_ss gfc_ss_terminator_var;
97	gfc_ss * const gfc_ss_terminator = &gfc_ss_terminator_var;
98
99
100	static tree
101	gfc_array_dataptr_type (tree desc)
102	{
103	return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc))(((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 103, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 103, __FUNCTION__))->type_with_lang_specific.lang_specific )->dataptr_type));
104	}
105
106	/* Build expressions to access members of the CFI descriptor. */
107	#define CFI_FIELD_BASE_ADDR 0
108	#define CFI_FIELD_ELEM_LEN 1
109	#define CFI_FIELD_VERSION 2
110	#define CFI_FIELD_RANK 3
111	#define CFI_FIELD_ATTRIBUTE 4
112	#define CFI_FIELD_TYPE 5
113	#define CFI_FIELD_DIM 6
114
115	#define CFI_DIM_FIELD_LOWER_BOUND 0
116	#define CFI_DIM_FIELD_EXTENT 1
117	#define CFI_DIM_FIELD_SM 2
118
119	static tree
120	gfc_get_cfi_descriptor_field (tree desc, unsigned field_idx)
121	{
122	tree type = TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 122, __FUNCTION__))->typed.type);
123	gcc_assert (TREE_CODE (type) == RECORD_TYPE((void)(!(((enum tree_code) (type)->base.code) == RECORD_TYPE && ((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 124, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values) && (strcmp ("base_addr" , ((const char *) (tree_check ((((contains_struct_check ((((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values)), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str )) == 0)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 127, __FUNCTION__), 0 : 0))
124	&& TYPE_FIELDS (type)((void)(!(((enum tree_code) (type)->base.code) == RECORD_TYPE && ((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 124, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values) && (strcmp ("base_addr" , ((const char *) (tree_check ((((contains_struct_check ((((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values)), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str )) == 0)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 127, __FUNCTION__), 0 : 0))
125	&& (strcmp ("base_addr",((void)(!(((enum tree_code) (type)->base.code) == RECORD_TYPE && ((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 124, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values) && (strcmp ("base_addr" , ((const char *) (tree_check ((((contains_struct_check ((((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values)), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str )) == 0)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 127, __FUNCTION__), 0 : 0))
126	IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (type))))((void)(!(((enum tree_code) (type)->base.code) == RECORD_TYPE && ((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 124, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values) && (strcmp ("base_addr" , ((const char *) (tree_check ((((contains_struct_check ((((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values)), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str )) == 0)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 127, __FUNCTION__), 0 : 0))
127	== 0))((void)(!(((enum tree_code) (type)->base.code) == RECORD_TYPE && ((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 124, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values) && (strcmp ("base_addr" , ((const char *) (tree_check ((((contains_struct_check ((((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values)), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 126, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str )) == 0)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 127, __FUNCTION__), 0 : 0));
128	tree field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 128, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), field_idx);
129	gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 129, __FUNCTION__), 0 : 0));
130
131	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 131, __FUNCTION__))->typed.type),
132	desc, field, NULL_TREE(tree) __null);
133	}
134
135	tree
136	gfc_get_cfi_desc_base_addr (tree desc)
137	{
138	return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_BASE_ADDR);
139	}
140
141	tree
142	gfc_get_cfi_desc_elem_len (tree desc)
143	{
144	return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ELEM_LEN);
145	}
146
147	tree
148	gfc_get_cfi_desc_version (tree desc)
149	{
150	return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_VERSION);
151	}
152
153	tree
154	gfc_get_cfi_desc_rank (tree desc)
155	{
156	return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_RANK);
157	}
158
159	tree
160	gfc_get_cfi_desc_type (tree desc)
161	{
162	return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_TYPE);
163	}
164
165	tree
166	gfc_get_cfi_desc_attribute (tree desc)
167	{
168	return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ATTRIBUTE);
169	}
170
171	static tree
172	gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
173	{
174	tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
175	tmp = gfc_build_array_ref (tmp, idx, NULL_TREE(tree) __null, true);
176	tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp))((tree_check3 ((((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 176, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 176, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), field_idx);
177	gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 177, __FUNCTION__), 0 : 0));
178	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 178, __FUNCTION__))->typed.type),
179	tmp, field, NULL_TREE(tree) __null);
180	}
181
182	tree
183	gfc_get_cfi_dim_lbound (tree desc, tree idx)
184	{
185	return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_LOWER_BOUND);
186	}
187
188	tree
189	gfc_get_cfi_dim_extent (tree desc, tree idx)
190	{
191	return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_EXTENT);
192	}
193
194	tree
195	gfc_get_cfi_dim_sm (tree desc, tree idx)
196	{
197	return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_SM);
198	}
199
200	#undef CFI_FIELD_BASE_ADDR
201	#undef CFI_FIELD_ELEM_LEN
202	#undef CFI_FIELD_VERSION
203	#undef CFI_FIELD_RANK
204	#undef CFI_FIELD_ATTRIBUTE
205	#undef CFI_FIELD_TYPE
206	#undef CFI_FIELD_DIM
207
208	#undef CFI_DIM_FIELD_LOWER_BOUND
209	#undef CFI_DIM_FIELD_EXTENT
210	#undef CFI_DIM_FIELD_SM
211
212	/* Build expressions to access the members of an array descriptor.
213	It's surprisingly easy to mess up here, so never access
214	an array descriptor by "brute force", always use these
215	functions. This also avoids problems if we change the format
216	of an array descriptor.
217
218	To understand these magic numbers, look at the comments
219	before gfc_build_array_type() in trans-types.cc.
220
221	The code within these defines should be the only code which knows the format
222	of an array descriptor.
223
224	Any code just needing to read obtain the bounds of an array should use
225	gfc_conv_array_* rather than the following functions as these will return
226	know constant values, and work with arrays which do not have descriptors.
227
228	Don't forget to #undef these! */
229
230	#define DATA_FIELD 0
231	#define OFFSET_FIELD 1
232	#define DTYPE_FIELD 2
233	#define SPAN_FIELD 3
234	#define DIMENSION_FIELD 4
235	#define CAF_TOKEN_FIELD 5
236
237	#define STRIDE_SUBFIELD 0
238	#define LBOUND_SUBFIELD 1
239	#define UBOUND_SUBFIELD 2
240
241	static tree
242	gfc_get_descriptor_field (tree desc, unsigned field_idx)
243	{
244	tree type = TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 244, __FUNCTION__))->typed.type);
245	gcc_assert (GFC_DESCRIPTOR_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 245, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 245, __FUNCTION__), 0 : 0));
246
247	tree field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 247, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), field_idx);
248	gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 248, __FUNCTION__), 0 : 0));
249
250	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 250, __FUNCTION__))->typed.type),
251	desc, field, NULL_TREE(tree) __null);
252	}
253
254	/* This provides READ-ONLY access to the data field. The field itself
255	doesn't have the proper type. */
256
257	tree
258	gfc_conv_descriptor_data_get (tree desc)
259	{
260	tree type = TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 260, __FUNCTION__))->typed.type);
261	if (TREE_CODE (type)((enum tree_code) (type)->base.code) == REFERENCE_TYPE)
262	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 262, __FUNCTION__));
263
264	tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
265	return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field)fold_convert_loc (((location_t) 0), (((tree_class_check ((type ), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 265, __FUNCTION__))->type_with_lang_specific.lang_specific )->dataptr_type), field);
266	}
267
268	/* This provides WRITE access to the data field.
269
270	TUPLES_P is true if we are generating tuples.
271
272	This function gets called through the following macros:
273	gfc_conv_descriptor_data_set
274	gfc_conv_descriptor_data_set. */
275
276	void
277	gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
278	{
279	tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
280	gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 280, __FUNCTION__))->typed.type), value));
281	}
282
283
284	/* This provides address access to the data field. This should only be
285	used by array allocation, passing this on to the runtime. */
286
287	tree
288	gfc_conv_descriptor_data_addr (tree desc)
289	{
290	tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
291	return gfc_build_addr_expr (NULL_TREE(tree) __null, field);
292	}
293
294	static tree
295	gfc_conv_descriptor_offset (tree desc)
296	{
297	tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
298	gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 298, __FUNCTION__))->typed.type) == gfc_array_index_type ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 298, __FUNCTION__), 0 : 0));
299	return field;
300	}
301
302	tree
303	gfc_conv_descriptor_offset_get (tree desc)
304	{
305	return gfc_conv_descriptor_offset (desc);
306	}
307
308	void
309	gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
310	tree value)
311	{
312	tree t = gfc_conv_descriptor_offset (desc);
313	gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (t), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 313, __FUNCTION__))->typed.type), value));
314	}
315
316
317	tree
318	gfc_conv_descriptor_dtype (tree desc)
319	{
320	tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
321	gcc_assert (TREE_TYPE (field) == get_dtype_type_node ())((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 321, __FUNCTION__))->typed.type) == get_dtype_type_node ( )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 321, __FUNCTION__), 0 : 0));
322	return field;
323	}
324
325	static tree
326	gfc_conv_descriptor_span (tree desc)
327	{
328	tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
329	gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 329, __FUNCTION__))->typed.type) == gfc_array_index_type ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 329, __FUNCTION__), 0 : 0));
330	return field;
331	}
332
333	tree
334	gfc_conv_descriptor_span_get (tree desc)
335	{
336	return gfc_conv_descriptor_span (desc);
337	}
338
339	void
340	gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
341	tree value)
342	{
343	tree t = gfc_conv_descriptor_span (desc);
344	gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (t), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 344, __FUNCTION__))->typed.type), value));
345	}
346
347
348	tree
349	gfc_conv_descriptor_rank (tree desc)
350	{
351	tree tmp;
352	tree dtype;
353
354	dtype = gfc_conv_descriptor_dtype (desc);
355	tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype))((tree_check3 ((((contains_struct_check ((dtype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 355, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 355, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), GFC_DTYPE_RANK2);
356	gcc_assert (tmp != NULL_TREE((void)(!(tmp != (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 357, __FUNCTION__))->typed.type) == integer_types[itk_signed_char ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 357, __FUNCTION__), 0 : 0))
357	&& TREE_TYPE (tmp) == signed_char_type_node)((void)(!(tmp != (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 357, __FUNCTION__))->typed.type) == integer_types[itk_signed_char ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 357, __FUNCTION__), 0 : 0));
358	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 358, __FUNCTION__))->typed.type),
359	dtype, tmp, NULL_TREE(tree) __null);
360	}
361
362
363	/* Return the element length from the descriptor dtype field. */
364
365	tree
366	gfc_conv_descriptor_elem_len (tree desc)
367	{
368	tree tmp;
369	tree dtype;
370
371	dtype = gfc_conv_descriptor_dtype (desc);
372	tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype))((tree_check3 ((((contains_struct_check ((dtype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 372, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 372, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values),
373	GFC_DTYPE_ELEM_LEN0);
374	gcc_assert (tmp != NULL_TREE((void)(!(tmp != (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 375, __FUNCTION__))->typed.type) == global_trees[TI_SIZE_TYPE ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 375, __FUNCTION__), 0 : 0))
375	&& TREE_TYPE (tmp) == size_type_node)((void)(!(tmp != (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 375, __FUNCTION__))->typed.type) == global_trees[TI_SIZE_TYPE ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 375, __FUNCTION__), 0 : 0));
376	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 376, __FUNCTION__))->typed.type),
377	dtype, tmp, NULL_TREE(tree) __null);
378	}
379
380
381	tree
382	gfc_conv_descriptor_attribute (tree desc)
383	{
384	tree tmp;
385	tree dtype;
386
387	dtype = gfc_conv_descriptor_dtype (desc);
388	tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype))((tree_check3 ((((contains_struct_check ((dtype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 388, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 388, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values),
389	GFC_DTYPE_ATTRIBUTE4);
390	gcc_assert (tmp!= NULL_TREE((void)(!(tmp!= (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 391, __FUNCTION__))->typed.type) == integer_types[itk_short ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 391, __FUNCTION__), 0 : 0))
391	&& TREE_TYPE (tmp) == short_integer_type_node)((void)(!(tmp!= (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 391, __FUNCTION__))->typed.type) == integer_types[itk_short ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 391, __FUNCTION__), 0 : 0));
392	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 392, __FUNCTION__))->typed.type),
393	dtype, tmp, NULL_TREE(tree) __null);
394	}
395
396	tree
397	gfc_conv_descriptor_type (tree desc)
398	{
399	tree tmp;
400	tree dtype;
401
402	dtype = gfc_conv_descriptor_dtype (desc);
403	tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype))((tree_check3 ((((contains_struct_check ((dtype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 403, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 403, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), GFC_DTYPE_TYPE3);
404	gcc_assert (tmp!= NULL_TREE((void)(!(tmp!= (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 405, __FUNCTION__))->typed.type) == integer_types[itk_signed_char ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 405, __FUNCTION__), 0 : 0))
405	&& TREE_TYPE (tmp) == signed_char_type_node)((void)(!(tmp!= (tree) __null && ((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 405, __FUNCTION__))->typed.type) == integer_types[itk_signed_char ]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 405, __FUNCTION__), 0 : 0));
406	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 406, __FUNCTION__))->typed.type),
407	dtype, tmp, NULL_TREE(tree) __null);
408	}
409
410	tree
411	gfc_get_descriptor_dimension (tree desc)
412	{
413	tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD);
414	gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE((void)(!(((enum tree_code) (((contains_struct_check ((field) , (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 414, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE && ((enum tree_code) (((contains_struct_check ((((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 415, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 415, __FUNCTION__))->typed.type))->base.code) == RECORD_TYPE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 415, __FUNCTION__), 0 : 0))
415	&& TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE)((void)(!(((enum tree_code) (((contains_struct_check ((field) , (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 414, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE && ((enum tree_code) (((contains_struct_check ((((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 415, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 415, __FUNCTION__))->typed.type))->base.code) == RECORD_TYPE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 415, __FUNCTION__), 0 : 0));
416	return field;
417	}
418
419
420	static tree
421	gfc_conv_descriptor_dimension (tree desc, tree dim)
422	{
423	tree tmp;
424
425	tmp = gfc_get_descriptor_dimension (desc);
426
427	return gfc_build_array_ref (tmp, dim, NULL_TREE(tree) __null, true);
428	}
429
430
431	tree
432	gfc_conv_descriptor_token (tree desc)
433	{
434	gcc_assert (flag_coarray == GFC_FCOARRAY_LIB)((void)(!(global_options.x_flag_coarray == GFC_FCOARRAY_LIB) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 434, __FUNCTION__), 0 : 0));
435	tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD);
436	/* Should be a restricted pointer - except in the finalization wrapper. */
437	gcc_assert (TREE_TYPE (field) == prvoid_type_node((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 437, __FUNCTION__))->typed.type) == prvoid_type_node \|\| ( (contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 438, __FUNCTION__))->typed.type) == pvoid_type_node) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 438, __FUNCTION__), 0 : 0))
438	\|\| TREE_TYPE (field) == pvoid_type_node)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 437, __FUNCTION__))->typed.type) == prvoid_type_node \|\| ( (contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 438, __FUNCTION__))->typed.type) == pvoid_type_node) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 438, __FUNCTION__), 0 : 0));
439	return field;
440	}
441
442	static tree
443	gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
444	{
445	tree tmp = gfc_conv_descriptor_dimension (desc, dim);
446	tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp))((tree_check3 ((((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 446, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 446, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), field_idx);
447	gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 447, __FUNCTION__), 0 : 0));
448
449	return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 449, __FUNCTION__))->typed.type),
450	tmp, field, NULL_TREE(tree) __null);
451	}
452
453	static tree
454	gfc_conv_descriptor_stride (tree desc, tree dim)
455	{
456	tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD);
457	gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 457, __FUNCTION__))->typed.type) == gfc_array_index_type ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 457, __FUNCTION__), 0 : 0));
458	return field;
459	}
460
461	tree
462	gfc_conv_descriptor_stride_get (tree desc, tree dim)
463	{
464	tree type = TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 464, __FUNCTION__))->typed.type);
465	gcc_assert (GFC_DESCRIPTOR_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 465, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 465, __FUNCTION__), 0 : 0));
466	if (integer_zerop (dim)
467	&& (GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 467, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_ALLOCATABLE
468	\|\|GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 468, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_ASSUMED_SHAPE_CONT
469	\|\|GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 469, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_ASSUMED_RANK_CONT
470	\|\|GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 470, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_POINTER_CONT))
471	return gfc_index_one_nodegfc_rank_cst[1];
472
473	return gfc_conv_descriptor_stride (desc, dim);
474	}
475
476	void
477	gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
478	tree dim, tree value)
479	{
480	tree t = gfc_conv_descriptor_stride (desc, dim);
481	gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (t), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 481, __FUNCTION__))->typed.type), value));
482	}
483
484	static tree
485	gfc_conv_descriptor_lbound (tree desc, tree dim)
486	{
487	tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD);
488	gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 488, __FUNCTION__))->typed.type) == gfc_array_index_type ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 488, __FUNCTION__), 0 : 0));
489	return field;
490	}
491
492	tree
493	gfc_conv_descriptor_lbound_get (tree desc, tree dim)
494	{
495	return gfc_conv_descriptor_lbound (desc, dim);
496	}
497
498	void
499	gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
500	tree dim, tree value)
501	{
502	tree t = gfc_conv_descriptor_lbound (desc, dim);
503	gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (t), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 503, __FUNCTION__))->typed.type), value));
504	}
505
506	static tree
507	gfc_conv_descriptor_ubound (tree desc, tree dim)
508	{
509	tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD);
510	gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 510, __FUNCTION__))->typed.type) == gfc_array_index_type ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 510, __FUNCTION__), 0 : 0));
511	return field;
512	}
513
514	tree
515	gfc_conv_descriptor_ubound_get (tree desc, tree dim)
516	{
517	return gfc_conv_descriptor_ubound (desc, dim);
518	}
519
520	void
521	gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
522	tree dim, tree value)
523	{
524	tree t = gfc_conv_descriptor_ubound (desc, dim);
525	gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (t), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 525, __FUNCTION__))->typed.type), value));
526	}
527
528	/* Build a null array descriptor constructor. */
529
530	tree
531	gfc_build_null_descriptor (tree type)
532	{
533	tree field;
534	tree tmp;
535
536	gcc_assert (GFC_DESCRIPTOR_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 536, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 536, __FUNCTION__), 0 : 0));
537	gcc_assert (DATA_FIELD == 0)((void)(!(DATA_FIELD == 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 537, __FUNCTION__), 0 : 0));
538	field = TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 538, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values);
539
540	/* Set a NULL data pointer. */
541	tmp = build_constructor_single (type, field, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
542	TREE_CONSTANT (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 542, __FUNCTION__))->base.constant_flag) = 1;
543	/* All other fields are ignored. */
544
545	return tmp;
546	}
547
548
549	/* Modify a descriptor such that the lbound of a given dimension is the value
550	specified. This also updates ubound and offset accordingly. */
551
552	void
553	gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
554	int dim, tree new_lbound)
555	{
556	tree offs, ubound, lbound, stride;
557	tree diff, offs_diff;
558
559	new_lbound = fold_convert (gfc_array_index_type, new_lbound)fold_convert_loc (((location_t) 0), gfc_array_index_type, new_lbound );
560
561	offs = gfc_conv_descriptor_offset_get (desc);
562	lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
563	ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
564	stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
565
566	/* Get difference (new - old) by which to shift stuff. */
567	diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
568	new_lbound, lbound);
569
570	/* Shift ubound and offset accordingly. This has to be done before
571	updating the lbound, as they depend on the lbound expression! */
572	ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
573	ubound, diff);
574	gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
575	offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
576	diff, stride);
577	offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
578	offs, offs_diff);
579	gfc_conv_descriptor_offset_set (block, desc, offs);
580
581	/* Finally set lbound to value we want. */
582	gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
583	}
584
585
586	/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
587
588	void
589	gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
590	tree dtype_off, tree span_off,
591	tree dim_off, tree dim_size,
592	tree stride_suboff, tree lower_suboff,
593	tree *upper_suboff)
594	{
595	tree field;
596	tree type;
597
598	type = TYPE_MAIN_VARIANT (desc_type)((tree_class_check ((desc_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 598, __FUNCTION__))->type_common.main_variant);
599	field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 599, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), DATA_FIELD);
600	*data_off = byte_position (field);
601	field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 601, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), DTYPE_FIELD);
602	*dtype_off = byte_position (field);
603	field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 603, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), SPAN_FIELD);
604	*span_off = byte_position (field);
605	field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 605, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), DIMENSION_FIELD);
606	*dim_off = byte_position (field);
607	type = TREE_TYPE (TREE_TYPE (field))((contains_struct_check ((((contains_struct_check ((field), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 607, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 607, __FUNCTION__))->typed.type);
608	*dim_size = TYPE_SIZE_UNIT (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 608, __FUNCTION__))->type_common.size_unit);
609	field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 609, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), STRIDE_SUBFIELD);
610	*stride_suboff = byte_position (field);
611	field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 611, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), LBOUND_SUBFIELD);
612	*lower_suboff = byte_position (field);
613	field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 613, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values), UBOUND_SUBFIELD);
614	*upper_suboff = byte_position (field);
615	}
616
617
618	/* Cleanup those #defines. */
619
620	#undef DATA_FIELD
621	#undef OFFSET_FIELD
622	#undef DTYPE_FIELD
623	#undef SPAN_FIELD
624	#undef DIMENSION_FIELD
625	#undef CAF_TOKEN_FIELD
626	#undef STRIDE_SUBFIELD
627	#undef LBOUND_SUBFIELD
628	#undef UBOUND_SUBFIELD
629
630
631	/* Mark a SS chain as used. Flags specifies in which loops the SS is used.
632	flags & 1 = Main loop body.
633	flags & 2 = temp copy loop. */
634
635	void
636	gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags)
637	{
638	for (; ss != gfc_ss_terminator; ss = ss->next)
639	ss->info->useflags = flags;
640	}
641
642
643	/* Free a gfc_ss chain. */
644
645	void
646	gfc_free_ss_chain (gfc_ss * ss)
647	{
648	gfc_ss *next;
649
650	while (ss != gfc_ss_terminator)
651	{
652	gcc_assert (ss != NULL)((void)(!(ss != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 652, __FUNCTION__), 0 : 0));
653	next = ss->next;
654	gfc_free_ss (ss);
655	ss = next;
656	}
657	}
658
659
660	static void
661	free_ss_info (gfc_ss_info *ss_info)
662	{
663	int n;
664
665	ss_info->refcount--;
666	if (ss_info->refcount > 0)
667	return;
668
669	gcc_assert (ss_info->refcount == 0)((void)(!(ss_info->refcount == 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 669, __FUNCTION__), 0 : 0));
670
671	switch (ss_info->type)
672	{
673	case GFC_SS_SECTION:
674	for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
675	if (ss_info->data.array.subscript[n])
676	gfc_free_ss_chain (ss_info->data.array.subscript[n]);
677	break;
678
679	default:
680	break;
681	}
682
683	free (ss_info);
684	}
685
686
687	/* Free a SS. */
688
689	void
690	gfc_free_ss (gfc_ss * ss)
691	{
692	free_ss_info (ss->info);
693	free (ss);
694	}
695
696
697	/* Creates and initializes an array type gfc_ss struct. */
698
699	gfc_ss *
700	gfc_get_array_ss (gfc_ss next, gfc_expr expr, int dimen, gfc_ss_type type)
701	{
702	gfc_ss *ss;
703	gfc_ss_info *ss_info;
704	int i;
705
706	ss_info = gfc_get_ss_info ()((gfc_ss_info *) xcalloc (1, sizeof (gfc_ss_info)));
707	ss_info->refcount++;
708	ss_info->type = type;
709	ss_info->expr = expr;
710
711	ss = gfc_get_ss ()((gfc_ss *) xcalloc (1, sizeof (gfc_ss)));
712	ss->info = ss_info;
713	ss->next = next;
714	ss->dimen = dimen;
715	for (i = 0; i < ss->dimen; i++)
716	ss->dim[i] = i;
717
718	return ss;
719	}
720
721
722	/* Creates and initializes a temporary type gfc_ss struct. */
723
724	gfc_ss *
725	gfc_get_temp_ss (tree type, tree string_length, int dimen)
726	{
727	gfc_ss *ss;
728	gfc_ss_info *ss_info;
729	int i;
730
731	ss_info = gfc_get_ss_info ()((gfc_ss_info *) xcalloc (1, sizeof (gfc_ss_info)));
732	ss_info->refcount++;
733	ss_info->type = GFC_SS_TEMP;
734	ss_info->string_length = string_length;
735	ss_info->data.temp.type = type;
736
737	ss = gfc_get_ss ()((gfc_ss *) xcalloc (1, sizeof (gfc_ss)));
738	ss->info = ss_info;
739	ss->next = gfc_ss_terminator;
740	ss->dimen = dimen;
741	for (i = 0; i < ss->dimen; i++)
742	ss->dim[i] = i;
743
744	return ss;
745	}
746
747
748	/* Creates and initializes a scalar type gfc_ss struct. */
749
750	gfc_ss *
751	gfc_get_scalar_ss (gfc_ss next, gfc_expr expr)
752	{
753	gfc_ss *ss;
754	gfc_ss_info *ss_info;
755
756	ss_info = gfc_get_ss_info ()((gfc_ss_info *) xcalloc (1, sizeof (gfc_ss_info)));
757	ss_info->refcount++;
758	ss_info->type = GFC_SS_SCALAR;
759	ss_info->expr = expr;
760
761	ss = gfc_get_ss ()((gfc_ss *) xcalloc (1, sizeof (gfc_ss)));
762	ss->info = ss_info;
763	ss->next = next;
764
765	return ss;
766	}
767
768
769	/* Free all the SS associated with a loop. */
770
771	void
772	gfc_cleanup_loop (gfc_loopinfo * loop)
773	{
774	gfc_loopinfo loop_next, *ploop;
775	gfc_ss *ss;
776	gfc_ss *next;
777
778	ss = loop->ss;
779	while (ss != gfc_ss_terminator)
780	{
781	gcc_assert (ss != NULL)((void)(!(ss != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 781, __FUNCTION__), 0 : 0));
782	next = ss->loop_chain;
783	gfc_free_ss (ss);
784	ss = next;
785	}
786
787	/* Remove reference to self in the parent loop. */
788	if (loop->parent)
789	for (ploop = &loop->parent->nested; ploop; ploop = &(ploop)->next)
790	if (*ploop == loop)
791	{
792	*ploop = loop->next;
793	break;
794	}
795
796	/* Free non-freed nested loops. */
797	for (loop = loop->nested; loop; loop = loop_next)
798	{
799	loop_next = loop->next;
800	gfc_cleanup_loop (loop);
801	free (loop);
802	}
803	}
804
805
806	static void
807	set_ss_loop (gfc_ss ss, gfc_loopinfo loop)
808	{
809	int n;
810
811	for (; ss != gfc_ss_terminator; ss = ss->next)
812	{
813	ss->loop = loop;
814
815	if (ss->info->type == GFC_SS_SCALAR
816	\|\| ss->info->type == GFC_SS_REFERENCE
817	\|\| ss->info->type == GFC_SS_TEMP)
818	continue;
819
820	for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
821	if (ss->info->data.array.subscript[n] != NULL__null)
822	set_ss_loop (ss->info->data.array.subscript[n], loop);
823	}
824	}
825
826
827	/* Associate a SS chain with a loop. */
828
829	void
830	gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
831	{
832	gfc_ss *ss;
833	gfc_loopinfo *nested_loop;
834
835	if (head == gfc_ss_terminator)
836	return;
837
838	set_ss_loop (head, loop);
839
840	ss = head;
841	for (; ss && ss != gfc_ss_terminator; ss = ss->next)
842	{
843	if (ss->nested_ss)
844	{
845	nested_loop = ss->nested_ss->loop;
846
847	/* More than one ss can belong to the same loop. Hence, we add the
848	loop to the chain only if it is different from the previously
849	added one, to avoid duplicate nested loops. */
850	if (nested_loop != loop->nested)
851	{
852	gcc_assert (nested_loop->parent == NULL)((void)(!(nested_loop->parent == __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 852, __FUNCTION__), 0 : 0));
853	nested_loop->parent = loop;
854
855	gcc_assert (nested_loop->next == NULL)((void)(!(nested_loop->next == __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 855, __FUNCTION__), 0 : 0));
856	nested_loop->next = loop->nested;
857	loop->nested = nested_loop;
858	}
859	else
860	gcc_assert (nested_loop->parent == loop)((void)(!(nested_loop->parent == loop) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 860, __FUNCTION__), 0 : 0));
861	}
862
863	if (ss->next == gfc_ss_terminator)
864	ss->loop_chain = loop->ss;
865	else
866	ss->loop_chain = ss->next;
867	}
868	gcc_assert (ss == gfc_ss_terminator)((void)(!(ss == gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 868, __FUNCTION__), 0 : 0));
869	loop->ss = head;
870	}
871
872
873	/* Returns true if the expression is an array pointer. */
874
875	static bool
876	is_pointer_array (tree expr)
877	{
878	if (expr == NULL_TREE(tree) __null
879	\|\| !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr))((tree_class_check ((((contains_struct_check ((expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 879, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 879, __FUNCTION__))->type_common.lang_flag_1)
880	\|\| GFC_CLASS_TYPE_P (TREE_TYPE (expr))((tree_class_check ((((contains_struct_check ((expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 880, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 880, __FUNCTION__))->type_common.lang_flag_4))
881	return false;
882
883	if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == VAR_DECL
884	&& GFC_DECL_PTR_ARRAY_P (expr)((contains_struct_check ((expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 884, __FUNCTION__))->decl_common.lang_flag_6))
885	return true;
886
887	if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == PARM_DECL
888	&& GFC_DECL_PTR_ARRAY_P (expr)((contains_struct_check ((expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 888, __FUNCTION__))->decl_common.lang_flag_6))
889	return true;
890
891	if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == INDIRECT_REF
892	&& GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 0))((contains_struct_check (((((const_cast<tree> (tree_operand_check ((expr), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 892, __FUNCTION__)))))), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 892, __FUNCTION__))->decl_common.lang_flag_6))
893	return true;
894
895	/* The field declaration is marked as an pointer array. */
896	if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == COMPONENT_REF
897	&& GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 1))((contains_struct_check (((((const_cast<tree> (tree_operand_check ((expr), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 897, __FUNCTION__)))))), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 897, __FUNCTION__))->decl_common.lang_flag_6)
898	&& !GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (expr, 1)))((tree_class_check ((((contains_struct_check (((((const_cast <tree> (tree_operand_check ((expr), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 898, __FUNCTION__)))))), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 898, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 898, __FUNCTION__))->type_common.lang_flag_4))
899	return true;
900
901	return false;
902	}
903
904
905	/* If the symbol or expression reference a CFI descriptor, return the
906	pointer to the converted gfc descriptor. If an array reference is
907	present as the last argument, check that it is the one applied to
908	the CFI descriptor in the expression. Note that the CFI object is
909	always the symbol in the expression! */
910
911	static bool
912	get_CFI_desc (gfc_symbol sym, gfc_expr expr,
913	tree desc, gfc_array_ref ar)
914	{
915	tree tmp;
916
917	if (!is_CFI_desc (sym, expr))
918	return false;
919
920	if (expr && ar)
921	{
922	if (!(expr->ref && expr->ref->type == REF_ARRAY)
923	\|\| (&expr->ref->u.ar != ar))
924	return false;
925	}
926
927	if (sym == NULL__null)
928	tmp = expr->symtree->n.sym->backend_decl;
929	else
930	tmp = sym->backend_decl;
931
932	if (tmp && DECL_LANG_SPECIFIC (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 932, __FUNCTION__))->decl_common.lang_specific) && GFC_DECL_SAVED_DESCRIPTOR (tmp)(((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 932, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
933	tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp)(((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 933, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
934
935	*desc = tmp;
936	return true;
937	}
938
939
940	/* Return the span of an array. */
941
942	tree
943	gfc_get_array_span (tree desc, gfc_expr *expr)
944	{
945	tree tmp;
946
947	if (is_pointer_array (desc)
948	\|\| (get_CFI_desc (NULL__null, expr, &desc, NULL__null)
949	&& (POINTER_TYPE_P (TREE_TYPE (desc))(((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 949, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 949, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )
950	? GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (desc)))((tree_class_check ((((contains_struct_check ((((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 950, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 950, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 950, __FUNCTION__))->type_common.lang_flag_1)
951	: GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 951, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 951, __FUNCTION__))->type_common.lang_flag_1))))
952	{
953	if (POINTER_TYPE_P (TREE_TYPE (desc))(((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 953, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 953, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
954	desc = build_fold_indirect_ref_loc (input_location, desc);
955
956	/* This will have the span field set. */
957	tmp = gfc_conv_descriptor_span_get (desc);
958	}
959	else if (expr->ts.type == BT_ASSUMED)
960	{
961	if (DECL_LANG_SPECIFIC (desc)((contains_struct_check ((desc), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 961, __FUNCTION__))->decl_common.lang_specific) && GFC_DECL_SAVED_DESCRIPTOR (desc)(((contains_struct_check ((desc), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 961, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
962	desc = GFC_DECL_SAVED_DESCRIPTOR (desc)(((contains_struct_check ((desc), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 962, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
963	if (POINTER_TYPE_P (TREE_TYPE (desc))(((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 963, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 963, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
964	desc = build_fold_indirect_ref_loc (input_location, desc);
965	tmp = gfc_conv_descriptor_span_get (desc);
966	}
967	else if (TREE_CODE (desc)((enum tree_code) (desc)->base.code) == COMPONENT_REF
968	&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 968, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 968, __FUNCTION__))->type_common.lang_flag_1)
969	&& GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (desc, 0)))((tree_class_check ((((contains_struct_check (((((const_cast <tree> (tree_operand_check ((desc), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 969, __FUNCTION__)))))), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 969, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 969, __FUNCTION__))->type_common.lang_flag_4))
970	{
971	/* The descriptor is a class _data field and so use the vtable
972	size for the receiving span field. */
973	tmp = gfc_get_vptr_from_expr (desc);
974	tmp = gfc_vptr_size_get (tmp);
975	}
976	else if (expr && expr->expr_type == EXPR_VARIABLE
977	&& expr->symtree->n.sym->ts.type == BT_CLASS
978	&& expr->ref->type == REF_COMPONENT
979	&& expr->ref->next->type == REF_ARRAY
980	&& expr->ref->next->next == NULL__null
981	&& CLASS_DATA (expr->symtree->n.sym)expr->symtree->n.sym->ts.u.derived->components->attr.dimension)
982	{
983	/* Dummys come in sometimes with the descriptor detached from
984	the class field or declaration. */
985	tmp = gfc_class_vptr_get (expr->symtree->n.sym->backend_decl);
986	tmp = gfc_vptr_size_get (tmp);
987	}
988	else
989	{
990	/* If none of the fancy stuff works, the span is the element
991	size of the array. Attempt to deal with unbounded character
992	types if possible. Otherwise, return NULL_TREE. */
993	tmp = gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 993, __FUNCTION__))->typed.type));
994	if (tmp && TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == ARRAY_TYPE && TYPE_STRING_FLAG (tmp)((tree_check2 ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 994, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common .string_flag))
995	{
996	gcc_assert (expr->ts.type == BT_CHARACTER)((void)(!(expr->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 996, __FUNCTION__), 0 : 0));
997
998	tmp = gfc_get_character_len_in_bytes (tmp);
999
1000	if (tmp == NULL_TREE(tree) __null \|\| integer_zerop (tmp))
1001	{
1002	tree bs;
1003
1004	tmp = gfc_get_expr_charlen (expr);
1005	tmp = fold_convert (gfc_array_index_type, tmp)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmp );
1006	bs = build_int_cst (gfc_array_index_type, expr->ts.kind);
1007	tmp = fold_build2_loc (input_location, MULT_EXPR,
1008	gfc_array_index_type, tmp, bs);
1009	}
1010
1011	tmp = (tmp && !integer_zerop (tmp))
1012	? (fold_convert (gfc_array_index_type, tmp)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmp )) : (NULL_TREE(tree) __null);
1013	}
1014	else
1015	tmp = fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, size_in_bytes (tmp))
1016	size_in_bytes (tmp))fold_convert_loc (((location_t) 0), gfc_array_index_type, size_in_bytes (tmp));
1017	}
1018	return tmp;
1019	}
1020
1021
1022	/* Generate an initializer for a static pointer or allocatable array. */
1023
1024	void
1025	gfc_trans_static_array_pointer (gfc_symbol * sym)
1026	{
1027	tree type;
1028
1029	gcc_assert (TREE_STATIC (sym->backend_decl))((void)(!(((sym->backend_decl)->base.static_flag)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1029, __FUNCTION__), 0 : 0));
1030	/* Just zero the data member. */
1031	type = TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1031, __FUNCTION__))->typed.type);
1032	DECL_INITIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1032, __FUNCTION__))->decl_common.initial) = gfc_build_null_descriptor (type);
1033	}
1034
1035
1036	/* If the bounds of SE's loop have not yet been set, see if they can be
1037	determined from array spec AS, which is the array spec of a called
1038	function. MAPPING maps the callee's dummy arguments to the values
1039	that the caller is passing. Add any initialization and finalization
1040	code to SE. */
1041
1042	void
1043	gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
1044	gfc_se * se, gfc_array_spec * as)
1045	{
1046	int n, dim, total_dim;
1047	gfc_se tmpse;
1048	gfc_ss *ss;
1049	tree lower;
1050	tree upper;
1051	tree tmp;
1052
1053	total_dim = 0;
1054
1055	if (!as \|\| as->type != AS_EXPLICIT)
1056	return;
1057
1058	for (ss = se->ss; ss; ss = ss->parent)
1059	{
1060	total_dim += ss->loop->dimen;
1061	for (n = 0; n < ss->loop->dimen; n++)
1062	{
1063	/* The bound is known, nothing to do. */
1064	if (ss->loop->to[n] != NULL_TREE(tree) __null)
1065	continue;
1066
1067	dim = ss->dim[n];
1068	gcc_assert (dim < as->rank)((void)(!(dim < as->rank) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1068, __FUNCTION__), 0 : 0));
1069	gcc_assert (ss->loop->dimen <= as->rank)((void)(!(ss->loop->dimen <= as->rank) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1069, __FUNCTION__), 0 : 0));
1070
1071	/* Evaluate the lower bound. */
1072	gfc_init_se (&tmpse, NULL__null);
1073	gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
1074	gfc_add_block_to_block (&se->pre, &tmpse.pre);
1075	gfc_add_block_to_block (&se->post, &tmpse.post);
1076	lower = fold_convert (gfc_array_index_type, tmpse.expr)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmpse .expr);
1077
1078	/* ...and the upper bound. */
1079	gfc_init_se (&tmpse, NULL__null);
1080	gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
1081	gfc_add_block_to_block (&se->pre, &tmpse.pre);
1082	gfc_add_block_to_block (&se->post, &tmpse.post);
1083	upper = fold_convert (gfc_array_index_type, tmpse.expr)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmpse .expr);
1084
1085	/* Set the upper bound of the loop to UPPER - LOWER. */
1086	tmp = fold_build2_loc (input_location, MINUS_EXPR,
1087	gfc_array_index_type, upper, lower);
1088	tmp = gfc_evaluate_now (tmp, &se->pre);
1089	ss->loop->to[n] = tmp;
1090	}
1091	}
1092
1093	gcc_assert (total_dim == as->rank)((void)(!(total_dim == as->rank) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1093, __FUNCTION__), 0 : 0));
1094	}
1095
1096
1097	/* Generate code to allocate an array temporary, or create a variable to
1098	hold the data. If size is NULL, zero the descriptor so that the
1099	callee will allocate the array. If DEALLOC is true, also generate code to
1100	free the array afterwards.
1101
1102	If INITIAL is not NULL, it is packed using internal_pack and the result used
1103	as data instead of allocating a fresh, unitialized area of memory.
1104
1105	Initialization code is added to PRE and finalization code to POST.
1106	DYNAMIC is true if the caller may want to extend the array later
1107	using realloc. This prevents us from putting the array on the stack. */
1108
1109	static void
1110	gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
1111	gfc_array_info * info, tree size, tree nelem,
1112	tree initial, bool dynamic, bool dealloc)
1113	{
1114	tree tmp;
1115	tree desc;
1116	bool onstack;
1117
1118	desc = info->descriptor;
1119	info->offset = gfc_index_zero_nodegfc_rank_cst[0];
1120	if (size == NULL_TREE(tree) __null \|\| integer_zerop (size))
1121	{
1122	/* A callee allocated array. */
1123	gfc_conv_descriptor_data_set (pre, desc, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
1124	onstack = FALSEfalse;
1125	}
1126	else
1127	{
1128	/* Allocate the temporary. */
1129	onstack = !dynamic && initial == NULL_TREE(tree) __null
1130	&& (flag_stack_arraysglobal_options.x_flag_stack_arrays
1131	\|\| gfc_can_put_var_on_stack (size));
1132
1133	if (onstack)
1134	{
1135	/* Make a temporary variable to hold the data. */
1136	tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (nelem)((contains_struct_check ((nelem), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1136, __FUNCTION__))->typed.type),
1137	nelem, gfc_index_one_nodegfc_rank_cst[1]);
1138	tmp = gfc_evaluate_now (tmp, pre);
1139	tmp = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
1140	tmp);
1141	tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1141, __FUNCTION__))->typed.type)),
1142	tmp);
1143	tmp = gfc_create_var (tmp, "A");
1144	/* If we're here only because of -fstack-arrays we have to
1145	emit a DECL_EXPR to make the gimplifier emit alloca calls. */
1146	if (!gfc_can_put_var_on_stack (size))
1147	gfc_add_expr_to_block (pre,
1148	fold_build1_loc (input_location,
1149	DECL_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1149, __FUNCTION__))->typed.type),
1150	tmp));
1151	tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
1152	gfc_conv_descriptor_data_set (pre, desc, tmp);
1153	}
1154	else
1155	{
1156	/* Allocate memory to hold the data or call internal_pack. */
1157	if (initial == NULL_TREE(tree) __null)
1158	{
1159	tmp = gfc_call_malloc (pre, NULL__null, size);
1160	tmp = gfc_evaluate_now (tmp, pre);
1161	}
1162	else
1163	{
1164	tree packed;
1165	tree source_data;
1166	tree was_packed;
1167	stmtblock_t do_copying;
1168
1169	tmp = TREE_TYPE (initial)((contains_struct_check ((initial), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1169, __FUNCTION__))->typed.type); /* Pointer to descriptor. */
1170	gcc_assert (TREE_CODE (tmp) == POINTER_TYPE)((void)(!(((enum tree_code) (tmp)->base.code) == POINTER_TYPE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1170, __FUNCTION__), 0 : 0));
1171	tmp = TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1171, __FUNCTION__))->typed.type); /* The descriptor itself. */
1172	tmp = gfc_get_element_type (tmp);
1173	packed = gfc_create_var (build_pointer_type (tmp), "data");
1174
1175	tmp = build_call_expr_loc (input_location,
1176	gfor_fndecl_in_pack, 1, initial);
1177	tmp = fold_convert (TREE_TYPE (packed), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (packed), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1177, __FUNCTION__))->typed.type), tmp);
1178	gfc_add_modify (pre, packed, tmp);
1179
1180	tmp = build_fold_indirect_ref_loc (input_location,
1181	initial);
1182	source_data = gfc_conv_descriptor_data_get (tmp);
1183
1184	/* internal_pack may return source->data without any allocation
1185	or copying if it is already packed. If that's the case, we
1186	need to allocate and copy manually. */
1187
1188	gfc_start_block (&do_copying);
1189	tmp = gfc_call_malloc (&do_copying, NULL__null, size);
1190	tmp = fold_convert (TREE_TYPE (packed), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (packed), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1190, __FUNCTION__))->typed.type), tmp);
1191	gfc_add_modify (&do_copying, packed, tmp);
1192	tmp = gfc_build_memcpy_call (packed, source_data, size);
1193	gfc_add_expr_to_block (&do_copying, tmp);
1194
1195	was_packed = fold_build2_loc (input_location, EQ_EXPR,
1196	logical_type_node, packed,
1197	source_data);
1198	tmp = gfc_finish_block (&do_copying);
1199	tmp = build3_v (COND_EXPR, was_packed, tmp,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], was_packed, tmp, build_empty_stmt (input_location))
1200	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], was_packed, tmp, build_empty_stmt (input_location));
1201	gfc_add_expr_to_block (pre, tmp);
1202
1203	tmp = fold_convert (pvoid_type_node, packed)fold_convert_loc (((location_t) 0), pvoid_type_node, packed);
1204	}
1205
1206	gfc_conv_descriptor_data_set (pre, desc, tmp);
1207	}
1208	}
1209	info->data = gfc_conv_descriptor_data_get (desc);
1210
1211	/* The offset is zero because we create temporaries with a zero
1212	lower bound. */
1213	gfc_conv_descriptor_offset_set (pre, desc, gfc_index_zero_nodegfc_rank_cst[0]);
1214
1215	if (dealloc && !onstack)
1216	{
1217	/* Free the temporary. */
1218	tmp = gfc_conv_descriptor_data_get (desc);
1219	tmp = gfc_call_free (tmp);
1220	gfc_add_expr_to_block (post, tmp);
1221	}
1222	}
1223
1224
1225	/* Get the scalarizer array dimension corresponding to actual array dimension
1226	given by ARRAY_DIM.
1227
1228	For example, if SS represents the array ref a(1,:,:,1), it is a
1229	bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1,
1230	and 1 for ARRAY_DIM=2.
1231	If SS represents transpose(a(:,1,1,:)), it is again a bidimensional
1232	scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for
1233	ARRAY_DIM=3.
1234	If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer
1235	array. If called on the inner ss, the result would be respectively 0,1,2 for
1236	ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1
1237	for ARRAY_DIM=1,2. */
1238
1239	static int
1240	get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim)
1241	{
1242	int array_ref_dim;
1243	int n;
1244
1245	array_ref_dim = 0;
1246
1247	for (; ss; ss = ss->parent)
1248	for (n = 0; n < ss->dimen; n++)
1249	if (ss->dim[n] < array_dim)
1250	array_ref_dim++;
1251
1252	return array_ref_dim;
1253	}
1254
1255
1256	static gfc_ss *
1257	innermost_ss (gfc_ss *ss)
1258	{
1259	while (ss->nested_ss != NULL__null)
1260	ss = ss->nested_ss;
1261
1262	return ss;
1263	}
1264
1265
1266
1267	/* Get the array reference dimension corresponding to the given loop dimension.
1268	It is different from the true array dimension given by the dim array in
1269	the case of a partial array reference (i.e. a(:,:,1,:) for example)
1270	It is different from the loop dimension in the case of a transposed array.
1271	*/
1272
1273	static int
1274	get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
1275	{
1276	return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
1277	ss->dim[loop_dim]);
1278	}
1279
1280
1281	/* Use the information in the ss to obtain the required information about
1282	the type and size of an array temporary, when the lhs in an assignment
1283	is a class expression. */
1284
1285	static tree
1286	get_class_info_from_ss (stmtblock_t * pre, gfc_ss ss, tree eltype)
1287	{
1288	gfc_ss *lhs_ss;
1289	gfc_ss *rhs_ss;
1290	tree tmp;
1291	tree tmp2;
1292	tree vptr;
1293	tree rhs_class_expr = NULL_TREE(tree) __null;
1294	tree lhs_class_expr = NULL_TREE(tree) __null;
1295	bool unlimited_rhs = false;
1296	bool unlimited_lhs = false;
1297	bool rhs_function = false;
1298	gfc_symbol *vtab;
1299
1300	/* The second element in the loop chain contains the source for the
1301	temporary; ie. the rhs of the assignment. */
1302	rhs_ss = ss->loop->ss->loop_chain;
1303
1304	if (rhs_ss != gfc_ss_terminator
1305	&& rhs_ss->info
1306	&& rhs_ss->info->expr
1307	&& rhs_ss->info->expr->ts.type == BT_CLASS
1308	&& rhs_ss->info->data.array.descriptor)
1309	{
1310	if (rhs_ss->info->expr->expr_type != EXPR_VARIABLE)
1311	rhs_class_expr
1312	= gfc_get_class_from_expr (rhs_ss->info->data.array.descriptor);
1313	else
1314	rhs_class_expr = gfc_get_class_from_gfc_expr (rhs_ss->info->expr);
1315	unlimited_rhs = UNLIMITED_POLY (rhs_ss->info->expr)(rhs_ss->info->expr != __null && rhs_ss->info ->expr->ts.type == BT_CLASS && rhs_ss->info-> expr->ts.u.derived->components && rhs_ss->info ->expr->ts.u.derived->components->ts.u.derived && rhs_ss->info->expr->ts.u.derived->components-> ts.u.derived->attr.unlimited_polymorphic);
1316	if (rhs_ss->info->expr->expr_type == EXPR_FUNCTION)
1317	rhs_function = true;
1318	}
1319
1320	/* For an assignment the lhs is the next element in the loop chain.
1321	If we have a class rhs, this had better be a class variable
1322	expression! */
1323	lhs_ss = rhs_ss->loop_chain;
1324	if (lhs_ss != gfc_ss_terminator
1325	&& lhs_ss->info
1326	&& lhs_ss->info->expr
1327	&& lhs_ss->info->expr->expr_type ==EXPR_VARIABLE
1328	&& lhs_ss->info->expr->ts.type == BT_CLASS)
1329	{
1330	tmp = lhs_ss->info->data.array.descriptor;
1331	unlimited_lhs = UNLIMITED_POLY (rhs_ss->info->expr)(rhs_ss->info->expr != __null && rhs_ss->info ->expr->ts.type == BT_CLASS && rhs_ss->info-> expr->ts.u.derived->components && rhs_ss->info ->expr->ts.u.derived->components->ts.u.derived && rhs_ss->info->expr->ts.u.derived->components-> ts.u.derived->attr.unlimited_polymorphic);
1332	}
1333	else
1334	tmp = NULL_TREE(tree) __null;
1335
1336	/* Get the lhs class expression. */
1337	if (tmp != NULL_TREE(tree) __null && lhs_ss->loop_chain == gfc_ss_terminator)
1338	lhs_class_expr = gfc_get_class_from_expr (tmp);
1339	else
1340	return rhs_class_expr;
1341
1342	gcc_assert (GFC_CLASS_TYPE_P (TREE_TYPE (lhs_class_expr)))((void)(!(((tree_class_check ((((contains_struct_check ((lhs_class_expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1342, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1342, __FUNCTION__))->type_common.lang_flag_4)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1342, __FUNCTION__), 0 : 0));
1343
1344	/* Set the lhs vptr and, if necessary, the _len field. */
1345	if (rhs_class_expr)
1346	{
1347	/* Both lhs and rhs are class expressions. */
1348	tmp = gfc_class_vptr_get (lhs_class_expr);
1349	gfc_add_modify (pre, tmp,
1350	fold_convert (TREE_TYPE (tmp),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1350, __FUNCTION__))->typed.type), gfc_class_vptr_get (rhs_class_expr ))
1351	gfc_class_vptr_get (rhs_class_expr))fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1350, __FUNCTION__))->typed.type), gfc_class_vptr_get (rhs_class_expr )));
1352	if (unlimited_lhs)
1353	{
1354	tmp = gfc_class_len_get (lhs_class_expr);
1355	if (unlimited_rhs)
1356	tmp2 = gfc_class_len_get (rhs_class_expr);
1357	else
1358	tmp2 = build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1358, __FUNCTION__))->typed.type), 0);
1359	gfc_add_modify (pre, tmp, tmp2);
1360	}
1361
1362	if (rhs_function)
1363	{
1364	tmp = gfc_class_data_get (rhs_class_expr);
1365	gfc_conv_descriptor_offset_set (pre, tmp, gfc_index_zero_nodegfc_rank_cst[0]);
1366	}
1367	}
1368	else
1369	{
1370	/* lhs is class and rhs is intrinsic or derived type. */
1371	*eltype = TREE_TYPE (rhs_ss->info->data.array.descriptor)((contains_struct_check ((rhs_ss->info->data.array.descriptor ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1371, __FUNCTION__))->typed.type);
1372	eltype = gfc_get_element_type (eltype);
1373	vtab = gfc_find_vtab (&rhs_ss->info->expr->ts);
1374	vptr = vtab->backend_decl;
1375	if (vptr == NULL_TREE(tree) __null)
1376	vptr = gfc_get_symbol_decl (vtab);
1377	vptr = gfc_build_addr_expr (NULL_TREE(tree) __null, vptr);
1378	tmp = gfc_class_vptr_get (lhs_class_expr);
1379	gfc_add_modify (pre, tmp,
1380	fold_convert (TREE_TYPE (tmp), vptr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1380, __FUNCTION__))->typed.type), vptr));
1381
1382	if (unlimited_lhs)
1383	{
1384	tmp = gfc_class_len_get (lhs_class_expr);
1385	if (rhs_ss->info
1386	&& rhs_ss->info->expr
1387	&& rhs_ss->info->expr->ts.type == BT_CHARACTER)
1388	tmp2 = build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1388, __FUNCTION__))->typed.type),
1389	rhs_ss->info->expr->ts.kind);
1390	else
1391	tmp2 = build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1391, __FUNCTION__))->typed.type), 0);
1392	gfc_add_modify (pre, tmp, tmp2);
1393	}
1394	}
1395
1396	return rhs_class_expr;
1397	}
1398
1399
1400
1401	/* Generate code to create and initialize the descriptor for a temporary
1402	array. This is used for both temporaries needed by the scalarizer, and
1403	functions returning arrays. Adjusts the loop variables to be
1404	zero-based, and calculates the loop bounds for callee allocated arrays.
1405	Allocate the array unless it's callee allocated (we have a callee
1406	allocated array if 'callee_alloc' is true, or if loop->to[n] is
1407	NULL_TREE for any n). Also fills in the descriptor, data and offset
1408	fields of info if known. Returns the size of the array, or NULL for a
1409	callee allocated array.
1410
1411	'eltype' == NULL signals that the temporary should be a class object.
1412	The 'initial' expression is used to obtain the size of the dynamic
1413	type; otherwise the allocation and initialization proceeds as for any
1414	other expression
1415
1416	PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
1417	gfc_trans_allocate_array_storage. */
1418
1419	tree
1420	gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
1421	tree eltype, tree initial, bool dynamic,
1422	bool dealloc, bool callee_alloc, locus * where)
1423	{
1424	gfc_loopinfo *loop;
1425	gfc_ss *s;
1426	gfc_array_info *info;
1427	tree from[GFC_MAX_DIMENSIONS15], to[GFC_MAX_DIMENSIONS15];
1428	tree type;
1429	tree desc;
1430	tree tmp;
1431	tree size;
1432	tree nelem;
1433	tree cond;
1434	tree or_expr;
1435	tree elemsize;
1436	tree class_expr = NULL_TREE(tree) __null;
1437	int n, dim, tmp_dim;
1438	int total_dim = 0;
1439
1440	/* This signals a class array for which we need the size of the
1441	dynamic type. Generate an eltype and then the class expression. */
1442	if (eltype == NULL_TREE(tree) __null && initial)
1443	{
1444	gcc_assert (POINTER_TYPE_P (TREE_TYPE (initial)))((void)(!((((enum tree_code) (((contains_struct_check ((initial ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1444, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((initial), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1444, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1444, __FUNCTION__), 0 : 0));
1445	class_expr = build_fold_indirect_ref_loc (input_location, initial);
1446	/* Obtain the structure (class) expression. */
1447	class_expr = gfc_get_class_from_expr (class_expr);
1448	gcc_assert (class_expr)((void)(!(class_expr) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1448, __FUNCTION__), 0 : 0));
1449	}
1450
1451	/* Otherwise, some expressions, such as class functions, arising from
1452	dependency checking in assignments come here with class element type.
1453	The descriptor can be obtained from the ss->info and then converted
1454	to the class object. */
1455	if (class_expr == NULL_TREE(tree) __null && GFC_CLASS_TYPE_P (eltype)((tree_class_check ((eltype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1455, __FUNCTION__))->type_common.lang_flag_4))
1456	class_expr = get_class_info_from_ss (pre, ss, &eltype);
1457
1458	/* If the dynamic type is not available, use the declared type. */
1459	if (eltype && GFC_CLASS_TYPE_P (eltype)((tree_class_check ((eltype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1459, __FUNCTION__))->type_common.lang_flag_4))
1460	eltype = gfc_get_element_type (TREE_TYPE (TYPE_FIELDS (eltype))((contains_struct_check ((((tree_check3 ((eltype), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1460, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1460, __FUNCTION__))->typed.type));
1461
1462	if (class_expr == NULL_TREE(tree) __null)
1463	elemsize = fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_class_check ((eltype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1464, __FUNCTION__))->type_common.size_unit))
1464	TYPE_SIZE_UNIT (eltype))fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_class_check ((eltype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1464, __FUNCTION__))->type_common.size_unit));
1465	else
1466	{
1467	/* Unlimited polymorphic entities are initialised with NULL vptr. They
1468	can be tested for by checking if the len field is present. If so
1469	test the vptr before using the vtable size. */
1470	tmp = gfc_class_vptr_get (class_expr);
1471	tmp = fold_build2_loc (input_location, NE_EXPR,
1472	logical_type_node,
1473	tmp, build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1473, __FUNCTION__))->typed.type), 0));
1474	elemsize = fold_build3_loc (input_location, COND_EXPR,
1475	gfc_array_index_type,
1476	tmp,
1477	gfc_class_vtab_size_get (class_expr),
1478	gfc_index_zero_nodegfc_rank_cst[0]);
1479	elemsize = gfc_evaluate_now (elemsize, pre);
1480	elemsize = gfc_resize_class_size_with_len (pre, class_expr, elemsize);
1481	/* Casting the data as a character of the dynamic length ensures that
1482	assignment of elements works when needed. */
1483	eltype = gfc_get_character_type_len (1, elemsize);
1484	}
1485
1486	memset (from, 0, sizeof (from));
1487	memset (to, 0, sizeof (to));
1488
1489	info = &ss->info->data.array;
1490
1491	gcc_assert (ss->dimen > 0)((void)(!(ss->dimen > 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1491, __FUNCTION__), 0 : 0));
1492	gcc_assert (ss->loop->dimen == ss->dimen)((void)(!(ss->loop->dimen == ss->dimen) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1492, __FUNCTION__), 0 : 0));
1493
1494	if (warn_array_temporariesglobal_options.x_warn_array_temporaries && where)
1495	gfc_warning (OPT_Warray_temporaries,
1496	"Creating array temporary at %L", where);
1497
1498	/* Set the lower bound to zero. */
1499	for (s = ss; s; s = s->parent)
1500	{
1501	loop = s->loop;
1502
1503	total_dim += loop->dimen;
1504	for (n = 0; n < loop->dimen; n++)
1505	{
1506	dim = s->dim[n];
1507
1508	/* Callee allocated arrays may not have a known bound yet. */
1509	if (loop->to[n])
1510	loop->to[n] = gfc_evaluate_now (
1511	fold_build2_loc (input_location, MINUS_EXPR,
1512	gfc_array_index_type,
1513	loop->to[n], loop->from[n]),
1514	pre);
1515	loop->from[n] = gfc_index_zero_nodegfc_rank_cst[0];
1516
1517	/* We have just changed the loop bounds, we must clear the
1518	corresponding specloop, so that delta calculation is not skipped
1519	later in gfc_set_delta. */
1520	loop->specloop[n] = NULL__null;
1521
1522	/* We are constructing the temporary's descriptor based on the loop
1523	dimensions. As the dimensions may be accessed in arbitrary order
1524	(think of transpose) the size taken from the n'th loop may not map
1525	to the n'th dimension of the array. We need to reconstruct loop
1526	infos in the right order before using it to set the descriptor
1527	bounds. */
1528	tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim);
1529	from[tmp_dim] = loop->from[n];
1530	to[tmp_dim] = loop->to[n];
1531
1532	info->delta[dim] = gfc_index_zero_nodegfc_rank_cst[0];
1533	info->start[dim] = gfc_index_zero_nodegfc_rank_cst[0];
1534	info->end[dim] = gfc_index_zero_nodegfc_rank_cst[0];
1535	info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
1536	}
1537	}
1538
1539	/* Initialize the descriptor. */
1540	type =
1541	gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
1542	GFC_ARRAY_UNKNOWN, true);
1543	desc = gfc_create_var (type, "atmp");
1544	GFC_DECL_PACKED_ARRAY (desc)((contains_struct_check ((desc), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1544, __FUNCTION__))->decl_common.lang_flag_0) = 1;
1545
1546	/* Emit a DECL_EXPR for the variable sized array type in
1547	GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
1548	sizes works correctly. */
1549	tree arraytype = TREE_TYPE (GFC_TYPE_ARRAY_DATAPTR_TYPE (type))((contains_struct_check (((((tree_class_check ((type), (tcc_type ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1549, __FUNCTION__))->type_with_lang_specific.lang_specific )->dataptr_type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1549, __FUNCTION__))->typed.type);
1550	if (! TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1550, __FUNCTION__))->type_common.name))
1551	TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1551, __FUNCTION__))->type_common.name) = build_decl (UNKNOWN_LOCATION((location_t) 0), TYPE_DECL,
1552	NULL_TREE(tree) __null, arraytype);
1553	gfc_add_expr_to_block (pre, build1 (DECL_EXPR,
1554	arraytype, TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1554, __FUNCTION__))->type_common.name)));
1555
1556	if (class_expr != NULL_TREE(tree) __null)
1557	{
1558	tree class_data;
1559	tree dtype;
1560
1561	/* Create a class temporary. */
1562	tmp = gfc_create_var (TREE_TYPE (class_expr)((contains_struct_check ((class_expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1562, __FUNCTION__))->typed.type), "ctmp");
1563	gfc_add_modify (pre, tmp, class_expr);
1564
1565	/* Assign the new descriptor to the _data field. This allows the
1566	vptr _copy to be used for scalarized assignment since the class
1567	temporary can be found from the descriptor. */
1568	class_data = gfc_class_data_get (tmp);
1569	tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
1570	TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1570, __FUNCTION__))->typed.type), desc);
1571	gfc_add_modify (pre, class_data, tmp);
1572
1573	/* Take the dtype from the class expression. */
1574	dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
1575	tmp = gfc_conv_descriptor_dtype (class_data);
1576	gfc_add_modify (pre, tmp, dtype);
1577
1578	/* Point desc to the class _data field. */
1579	desc = class_data;
1580	}
1581	else
1582	{
1583	/* Fill in the array dtype. */
1584	tmp = gfc_conv_descriptor_dtype (desc);
1585	gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1585, __FUNCTION__))->typed.type)));
1586	}
1587
1588	info->descriptor = desc;
1589	size = gfc_index_one_nodegfc_rank_cst[1];
1590
1591	/*
1592	Fill in the bounds and stride. This is a packed array, so:
1593
1594	size = 1;
1595	for (n = 0; n < rank; n++)
1596	{
1597	stride[n] = size
1598	delta = ubound[n] + 1 - lbound[n];
1599	size = size * delta;
1600	}
1601	size = size * sizeof(element);
1602	*/
1603
1604	or_expr = NULL_TREE(tree) __null;
1605
1606	/* If there is at least one null loop->to[n], it is a callee allocated
1607	array. */
1608	for (n = 0; n < total_dim; n++)
1609	if (to[n] == NULL_TREE(tree) __null)
1610	{
1611	size = NULL_TREE(tree) __null;
1612	break;
1613	}
1614
1615	if (size == NULL_TREE(tree) __null)
1616	for (s = ss; s; s = s->parent)
1617	for (n = 0; n < s->loop->dimen; n++)
1618	{
1619	dim = get_scalarizer_dim_for_array_dim (ss, s->dim[n]);
1620
1621	/* For a callee allocated array express the loop bounds in terms
1622	of the descriptor fields. */
1623	tmp = fold_build2_loc (input_location,
1624	MINUS_EXPR, gfc_array_index_type,
1625	gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
1626	gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
1627	s->loop->to[n] = tmp;
1628	}
1629	else
1630	{
1631	for (n = 0; n < total_dim; n++)
1632	{
1633	/* Store the stride and bound components in the descriptor. */
1634	gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
1635
1636	gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
1637	gfc_index_zero_nodegfc_rank_cst[0]);
1638
1639	gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
1640
1641	tmp = fold_build2_loc (input_location, PLUS_EXPR,
1642	gfc_array_index_type,
1643	to[n], gfc_index_one_nodegfc_rank_cst[1]);
1644
1645	/* Check whether the size for this dimension is negative. */
1646	cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
1647	tmp, gfc_index_zero_nodegfc_rank_cst[0]);
1648	cond = gfc_evaluate_now (cond, pre);
1649
1650	if (n == 0)
1651	or_expr = cond;
1652	else
1653	or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
1654	logical_type_node, or_expr, cond);
1655
1656	size = fold_build2_loc (input_location, MULT_EXPR,
1657	gfc_array_index_type, size, tmp);
1658	size = gfc_evaluate_now (size, pre);
1659	}
1660	}
1661
1662	/* Get the size of the array. */
1663	if (size && !callee_alloc)
1664	{
1665	/* If or_expr is true, then the extent in at least one
1666	dimension is zero and the size is set to zero. */
1667	size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
1668	or_expr, gfc_index_zero_nodegfc_rank_cst[0], size);
1669
1670	nelem = size;
1671	size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
1672	size, elemsize);
1673	}
1674	else
1675	{
1676	nelem = size;
1677	size = NULL_TREE(tree) __null;
1678	}
1679
1680	/* Set the span. */
1681	tmp = fold_convert (gfc_array_index_type, elemsize)fold_convert_loc (((location_t) 0), gfc_array_index_type, elemsize );
1682	gfc_conv_descriptor_span_set (pre, desc, tmp);
1683
1684	gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
1685	dynamic, dealloc);
1686
1687	while (ss->parent)
1688	ss = ss->parent;
1689
1690	if (ss->dimen > ss->loop->temp_dim)
1691	ss->loop->temp_dim = ss->dimen;
1692
1693	return size;
1694	}
1695
1696
1697	/* Return the number of iterations in a loop that starts at START,
1698	ends at END, and has step STEP. */
1699
1700	static tree
1701	gfc_get_iteration_count (tree start, tree end, tree step)
1702	{
1703	tree tmp;
1704	tree type;
1705
1706	type = TREE_TYPE (step)((contains_struct_check ((step), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1706, __FUNCTION__))->typed.type);
1707	tmp = fold_build2_loc (input_location, MINUS_EXPR, type, end, start);
1708	tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR, type, tmp, step);
1709	tmp = fold_build2_loc (input_location, PLUS_EXPR, type, tmp,
1710	build_int_cst (type, 1));
1711	tmp = fold_build2_loc (input_location, MAX_EXPR, type, tmp,
1712	build_int_cst (type, 0));
1713	return fold_convert (gfc_array_index_type, tmp)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmp );
1714	}
1715
1716
1717	/* Extend the data in array DESC by EXTRA elements. */
1718
1719	static void
1720	gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
1721	{
1722	tree arg0, arg1;
1723	tree tmp;
1724	tree size;
1725	tree ubound;
1726
1727	if (integer_zerop (extra))
1728	return;
1729
1730	ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
1731
1732	/* Add EXTRA to the upper bound. */
1733	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
1734	ubound, extra);
1735	gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
1736
1737	/* Get the value of the current data pointer. */
1738	arg0 = gfc_conv_descriptor_data_get (desc);
1739
1740	/* Calculate the new array size. */
1741	size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)))((tree_class_check ((gfc_get_element_type (((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1741, __FUNCTION__))->typed.type))), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1741, __FUNCTION__))->type_common.size_unit);
1742	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
1743	ubound, gfc_index_one_nodegfc_rank_cst[1]);
1744	arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_nodeglobal_trees[TI_SIZE_TYPE],
1745	fold_convert (size_type_node, tmp)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], tmp),
1746	fold_convert (size_type_node, size)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], size));
1747
1748	/* Call the realloc() function. */
1749	tmp = gfc_call_realloc (pblock, arg0, arg1);
1750	gfc_conv_descriptor_data_set (pblock, desc, tmp);
1751	}
1752
1753
1754	/* Return true if the bounds of iterator I can only be determined
1755	at run time. */
1756
1757	static inline bool
1758	gfc_iterator_has_dynamic_bounds (gfc_iterator * i)
1759	{
1760	return (i->start->expr_type != EXPR_CONSTANT
1761	\|\| i->end->expr_type != EXPR_CONSTANT
1762	\|\| i->step->expr_type != EXPR_CONSTANT);
1763	}
1764
1765
1766	/* Split the size of constructor element EXPR into the sum of two terms,
1767	one of which can be determined at compile time and one of which must
1768	be calculated at run time. Set *SIZE to the former and return true
1769	if the latter might be nonzero. */
1770
1771	static bool
1772	gfc_get_array_constructor_element_size (mpz_t * size, gfc_expr * expr)
1773	{
1774	if (expr->expr_type == EXPR_ARRAY)
1775	return gfc_get_array_constructor_size (size, expr->value.constructor);
1776	else if (expr->rank > 0)
1777	{
1778	/* Calculate everything at run time. */
1779	mpz_set_ui__gmpz_set_ui (*size, 0);
1780	return true;
1781	}
1782	else
1783	{
1784	/* A single element. */
1785	mpz_set_ui__gmpz_set_ui (*size, 1);
1786	return false;
1787	}
1788	}
1789
1790
1791	/* Like gfc_get_array_constructor_element_size, but applied to the whole
1792	of array constructor C. */
1793
1794	static bool
1795	gfc_get_array_constructor_size (mpz_t * size, gfc_constructor_base base)
1796	{
1797	gfc_constructor *c;
1798	gfc_iterator *i;
1799	mpz_t val;
1800	mpz_t len;
1801	bool dynamic;
1802
1803	mpz_set_ui__gmpz_set_ui (*size, 0);
1804	mpz_init__gmpz_init (len);
1805	mpz_init__gmpz_init (val);
1806
1807	dynamic = false;
1808	for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
1809	{
1810	i = c->iterator;
1811	if (i && gfc_iterator_has_dynamic_bounds (i))
1812	dynamic = true;
1813	else
1814	{
1815	dynamic \|= gfc_get_array_constructor_element_size (&len, c->expr);
1816	if (i)
1817	{
1818	/* Multiply the static part of the element size by the
1819	number of iterations. */
1820	mpz_sub__gmpz_sub (val, i->end->value.integer, i->start->value.integer);
1821	mpz_fdiv_q__gmpz_fdiv_q (val, val, i->step->value.integer);
1822	mpz_add_ui__gmpz_add_ui (val, val, 1);
1823	if (mpz_sgn (val)((val)->_mp_size < 0 ? -1 : (val)->_mp_size > 0) > 0)
1824	mpz_mul__gmpz_mul (len, len, val);
1825	else
1826	mpz_set_ui__gmpz_set_ui (len, 0);
1827	}
1828	mpz_add__gmpz_add (size, size, len);
1829	}
1830	}
1831	mpz_clear__gmpz_clear (len);
1832	mpz_clear__gmpz_clear (val);
1833	return dynamic;
1834	}
1835
1836
1837	/* Make sure offset is a variable. */
1838
1839	static void
1840	gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset,
1841	tree * offsetvar)
1842	{
1843	/* We should have already created the offset variable. We cannot
1844	create it here because we may be in an inner scope. */
1845	gcc_assert (offsetvar != NULL_TREE)((void)(!(offsetvar != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1845, __FUNCTION__), 0 : 0));
1846	gfc_add_modify (pblock, offsetvar, poffset);
1847	poffset = offsetvar;
1848	TREE_USED (offsetvar)((offsetvar)->base.used_flag) = 1;
1849	}
1850
1851
1852	/* Variables needed for bounds-checking. */
1853	static bool first_len;
1854	static tree first_len_val;
1855	static bool typespec_chararray_ctor;
1856
1857	static void
1858	gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
1859	tree offset, gfc_se * se, gfc_expr * expr)
1860	{
1861	tree tmp;
1862
1863	gfc_conv_expr (se, expr);
1864
1865	/* Store the value. */
1866	tmp = build_fold_indirect_ref_loc (input_location,
1867	gfc_conv_descriptor_data_get (desc));
1868	tmp = gfc_build_array_ref (tmp, offset, NULL__null);
1869
1870	if (expr->ts.type == BT_CHARACTER)
1871	{
1872	int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
1873	tree esize;
1874
1875	esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1875, __FUNCTION__))->typed.type)));
1876	esize = fold_convert (gfc_charlen_type_node, esize)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, esize );
1877	esize = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
1878	TREE_TYPE (esize)((contains_struct_check ((esize), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1878, __FUNCTION__))->typed.type), esize,
1879	build_int_cst (TREE_TYPE (esize)((contains_struct_check ((esize), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1879, __FUNCTION__))->typed.type),
1880	gfc_character_kinds[i].bit_size / 8));
1881
1882	gfc_conv_string_parameter (se);
1883	if (POINTER_TYPE_P (TREE_TYPE (tmp))(((enum tree_code) (((contains_struct_check ((tmp), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1883, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((tmp), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1883, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
1884	{
1885	/* The temporary is an array of pointers. */
1886	se->expr = fold_convert (TREE_TYPE (tmp), se->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1886, __FUNCTION__))->typed.type), se->expr);
1887	gfc_add_modify (&se->pre, tmp, se->expr);
1888	}
1889	else
1890	{
1891	/* The temporary is an array of string values. */
1892	tmp = gfc_build_addr_expr (gfc_get_pchar_type (expr->ts.kind), tmp);
1893	/* We know the temporary and the value will be the same length,
1894	so can use memcpy. */
1895	gfc_trans_string_copy (&se->pre, esize, tmp, expr->ts.kind,
1896	se->string_length, se->expr, expr->ts.kind);
1897	}
1898	if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0)) && !typespec_chararray_ctor)
1899	{
1900	if (first_len)
1901	{
1902	gfc_add_modify (&se->pre, first_len_val,
1903	fold_convert (TREE_TYPE (first_len_val),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (first_len_val), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1903, __FUNCTION__))->typed.type), se->string_length)
1904	se->string_length)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (first_len_val), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1903, __FUNCTION__))->typed.type), se->string_length));
1905	first_len = false;
1906	}
1907	else
1908	{
1909	/* Verify that all constructor elements are of the same
1910	length. */
1911	tree rhs = fold_convert (TREE_TYPE (first_len_val),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (first_len_val), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1911, __FUNCTION__))->typed.type), se->string_length)
1912	se->string_length)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (first_len_val), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1911, __FUNCTION__))->typed.type), se->string_length);
1913	tree cond = fold_build2_loc (input_location, NE_EXPR,
1914	logical_type_node, first_len_val,
1915	rhs);
1916	gfc_trans_runtime_check
1917	(true, false, cond, &se->pre, &expr->where,
1918	"Different CHARACTER lengths (%ld/%ld) in array constructor",
1919	fold_convert (long_integer_type_node, first_len_val)fold_convert_loc (((location_t) 0), integer_types[itk_long], first_len_val ),
1920	fold_convert (long_integer_type_node, se->string_length)fold_convert_loc (((location_t) 0), integer_types[itk_long], se ->string_length));
1921	}
1922	}
1923	}
1924	else if (GFC_CLASS_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1924, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1924, __FUNCTION__))->type_common.lang_flag_4)
1925	&& !GFC_CLASS_TYPE_P (gfc_get_element_type (TREE_TYPE (desc)))((tree_class_check ((gfc_get_element_type (((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1925, __FUNCTION__))->typed.type))), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1925, __FUNCTION__))->type_common.lang_flag_4))
1926	{
1927	/* Assignment of a CLASS array constructor to a derived type array. */
1928	if (expr->expr_type == EXPR_FUNCTION)
1929	se->expr = gfc_evaluate_now (se->expr, pblock);
1930	se->expr = gfc_class_data_get (se->expr);
1931	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
1932	se->expr = fold_convert (TREE_TYPE (tmp), se->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1932, __FUNCTION__))->typed.type), se->expr);
1933	gfc_add_modify (&se->pre, tmp, se->expr);
1934	}
1935	else
1936	{
1937	/* TODO: Should the frontend already have done this conversion? */
1938	se->expr = fold_convert (TREE_TYPE (tmp), se->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1938, __FUNCTION__))->typed.type), se->expr);
1939	gfc_add_modify (&se->pre, tmp, se->expr);
1940	}
1941
1942	gfc_add_block_to_block (pblock, &se->pre);
1943	gfc_add_block_to_block (pblock, &se->post);
1944	}
1945
1946
1947	/* Add the contents of an array to the constructor. DYNAMIC is as for
1948	gfc_trans_array_constructor_value. */
1949
1950	static void
1951	gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
1952	tree type ATTRIBUTE_UNUSED__attribute__ ((__unused__)),
1953	tree desc, gfc_expr * expr,
1954	tree * poffset, tree * offsetvar,
1955	bool dynamic)
1956	{
1957	gfc_se se;
1958	gfc_ss *ss;
1959	gfc_loopinfo loop;
1960	stmtblock_t body;
1961	tree tmp;
1962	tree size;
1963	int n;
1964
1965	/* We need this to be a variable so we can increment it. */
1966	gfc_put_offset_into_var (pblock, poffset, offsetvar);
1967
1968	gfc_init_se (&se, NULL__null);
1969
1970	/* Walk the array expression. */
1971	ss = gfc_walk_expr (expr);
1972	gcc_assert (ss != gfc_ss_terminator)((void)(!(ss != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 1972, __FUNCTION__), 0 : 0));
1973
1974	/* Initialize the scalarizer. */
1975	gfc_init_loopinfo (&loop);
1976	gfc_add_ss_to_loop (&loop, ss);
1977
1978	/* Initialize the loop. */
1979	gfc_conv_ss_startstride (&loop);
1980	gfc_conv_loop_setup (&loop, &expr->where);
1981
1982	/* Make sure the constructed array has room for the new data. */
1983	if (dynamic)
1984	{
1985	/* Set SIZE to the total number of elements in the subarray. */
1986	size = gfc_index_one_nodegfc_rank_cst[1];
1987	for (n = 0; n < loop.dimen; n++)
1988	{
1989	tmp = gfc_get_iteration_count (loop.from[n], loop.to[n],
1990	gfc_index_one_nodegfc_rank_cst[1]);
1991	size = fold_build2_loc (input_location, MULT_EXPR,
1992	gfc_array_index_type, size, tmp);
1993	}
1994
1995	/* Grow the constructed array by SIZE elements. */
1996	gfc_grow_array (&loop.pre, desc, size);
1997	}
1998
1999	/* Make the loop body. */
2000	gfc_mark_ss_chain_used (ss, 1);
2001	gfc_start_scalarized_body (&loop, &body);
2002	gfc_copy_loopinfo_to_se (&se, &loop);
2003	se.ss = ss;
2004
2005	gfc_trans_array_ctor_element (&body, desc, *poffset, &se, expr);
2006	gcc_assert (se.ss == gfc_ss_terminator)((void)(!(se.ss == gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2006, __FUNCTION__), 0 : 0));
2007
2008	/* Increment the offset. */
2009	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
2010	*poffset, gfc_index_one_nodegfc_rank_cst[1]);
2011	gfc_add_modify (&body, *poffset, tmp);
2012
2013	/* Finish the loop. */
2014	gfc_trans_scalarizing_loops (&loop, &body);
2015	gfc_add_block_to_block (&loop.pre, &loop.post);
2016	tmp = gfc_finish_block (&loop.pre);
2017	gfc_add_expr_to_block (pblock, tmp);
2018
2019	gfc_cleanup_loop (&loop);
2020	}
2021
2022
2023	/* Assign the values to the elements of an array constructor. DYNAMIC
2024	is true if descriptor DESC only contains enough data for the static
2025	size calculated by gfc_get_array_constructor_size. When true, memory
2026	for the dynamic parts must be allocated using realloc. */
2027
2028	static void
2029	gfc_trans_array_constructor_value (stmtblock_t * pblock,
2030	stmtblock_t * finalblock,
2031	tree type, tree desc,
2032	gfc_constructor_base base, tree * poffset,
2033	tree * offsetvar, bool dynamic)
2034	{
2035	tree tmp;
2036	tree start = NULL_TREE(tree) __null;
2037	tree end = NULL_TREE(tree) __null;
2038	tree step = NULL_TREE(tree) __null;
2039	stmtblock_t body;
2040	gfc_se se;
2041	mpz_t size;
2042	gfc_constructor *c;
2043	gfc_typespec ts;
2044	int ctr = 0;
2045
2046	tree shadow_loopvar = NULL_TREE(tree) __null;
2047	gfc_saved_var saved_loopvar;
2048
2049	ts.type = BT_UNKNOWN;
2050	mpz_init__gmpz_init (size);
2051	for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
2052	{
2053	ctr++;
2054	/* If this is an iterator or an array, the offset must be a variable. */
2055	if ((c->iterator \|\| c->expr->rank > 0) && INTEGER_CST_P (poffset)(((enum tree_code) (poffset)->base.code) == INTEGER_CST))
2056	gfc_put_offset_into_var (pblock, poffset, offsetvar);
2057
2058	/* Shadowing the iterator avoids changing its value and saves us from
2059	keeping track of it. Further, it makes sure that there's always a
2060	backend-decl for the symbol, even if there wasn't one before,
2061	e.g. in the case of an iterator that appears in a specification
2062	expression in an interface mapping. */
2063	if (c->iterator)
2064	{
2065	gfc_symbol *sym;
2066	tree type;
2067
2068	/* Evaluate loop bounds before substituting the loop variable
2069	in case they depend on it. Such a case is invalid, but it is
2070	not more expensive to do the right thing here.
2071	See PR 44354. */
2072	gfc_init_se (&se, NULL__null);
2073	gfc_conv_expr_val (&se, c->iterator->start);
2074	gfc_add_block_to_block (pblock, &se.pre);
2075	start = gfc_evaluate_now (se.expr, pblock);
2076
2077	gfc_init_se (&se, NULL__null);
2078	gfc_conv_expr_val (&se, c->iterator->end);
2079	gfc_add_block_to_block (pblock, &se.pre);
2080	end = gfc_evaluate_now (se.expr, pblock);
2081
2082	gfc_init_se (&se, NULL__null);
2083	gfc_conv_expr_val (&se, c->iterator->step);
2084	gfc_add_block_to_block (pblock, &se.pre);
2085	step = gfc_evaluate_now (se.expr, pblock);
2086
2087	sym = c->iterator->var->symtree->n.sym;
2088	type = gfc_typenode_for_spec (&sym->ts);
2089
2090	shadow_loopvar = gfc_create_var (type, "shadow_loopvar");
2091	gfc_shadow_sym (sym, shadow_loopvar, &saved_loopvar);
2092	}
2093
2094	gfc_start_block (&body);
2095
2096	if (c->expr->expr_type == EXPR_ARRAY)
2097	{
2098	/* Array constructors can be nested. */
2099	gfc_trans_array_constructor_value (&body, finalblock, type,
2100	desc, c->expr->value.constructor,
2101	poffset, offsetvar, dynamic);
2102	}
2103	else if (c->expr->rank > 0)
2104	{
2105	gfc_trans_array_constructor_subarray (&body, type, desc, c->expr,
2106	poffset, offsetvar, dynamic);
2107	}
2108	else
2109	{
2110	/* This code really upsets the gimplifier so don't bother for now. */
2111	gfc_constructor *p;
2112	HOST_WIDE_INTlong n;
2113	HOST_WIDE_INTlong size;
2114
2115	p = c;
2116	n = 0;
2117	while (p && !(p->iterator \|\| p->expr->expr_type != EXPR_CONSTANT))
2118	{
2119	p = gfc_constructor_next (p);
2120	n++;
2121	}
2122	if (n < 4)
2123	{
2124	/* Scalar values. */
2125	gfc_init_se (&se, NULL__null);
2126	gfc_trans_array_ctor_element (&body, desc, *poffset,
2127	&se, c->expr);
2128
2129	*poffset = fold_build2_loc (input_location, PLUS_EXPR,
2130	gfc_array_index_type,
2131	*poffset, gfc_index_one_nodegfc_rank_cst[1]);
2132	}
2133	else
2134	{
2135	/* Collect multiple scalar constants into a constructor. */
2136	vec<constructor_elt, va_gc> *v = NULL__null;
2137	tree init;
2138	tree bound;
2139	tree tmptype;
2140	HOST_WIDE_INTlong idx = 0;
2141
2142	p = c;
2143	/* Count the number of consecutive scalar constants. */
2144	while (p && !(p->iterator
2145	\|\| p->expr->expr_type != EXPR_CONSTANT))
2146	{
2147	gfc_init_se (&se, NULL__null);
2148	gfc_conv_constant (&se, p->expr);
2149
2150	if (c->expr->ts.type != BT_CHARACTER)
2151	se.expr = fold_convert (type, se.expr)fold_convert_loc (((location_t) 0), type, se.expr);
2152	/* For constant character array constructors we build
2153	an array of pointers. */
2154	else if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE \|\| ( (enum tree_code) (type)->base.code) == REFERENCE_TYPE))
2155	se.expr = gfc_build_addr_expr
2156	(gfc_get_pchar_type (p->expr->ts.kind),
2157	se.expr);
2158
2159	CONSTRUCTOR_APPEND_ELT (v,do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type , idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0)
2160	build_int_cst (gfc_array_index_type,do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type , idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0)
2161	idx++),do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type , idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0)
2162	se.expr)do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type , idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0);
2163	c = p;
2164	p = gfc_constructor_next (p);
2165	}
2166
2167	bound = size_int (n - 1)size_int_kind (n - 1, stk_sizetype);
2168	/* Create an array type to hold them. */
2169	tmptype = build_range_type (gfc_array_index_type,
2170	gfc_index_zero_nodegfc_rank_cst[0], bound);
2171	tmptype = build_array_type (type, tmptype);
2172
2173	init = build_constructor (tmptype, v);
2174	TREE_CONSTANT (init)((non_type_check ((init), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2174, __FUNCTION__))->base.constant_flag) = 1;
2175	TREE_STATIC (init)((init)->base.static_flag) = 1;
2176	/* Create a static variable to hold the data. */
2177	tmp = gfc_create_var (tmptype, "data");
2178	TREE_STATIC (tmp)((tmp)->base.static_flag) = 1;
2179	TREE_CONSTANT (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2179, __FUNCTION__))->base.constant_flag) = 1;
2180	TREE_READONLY (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2180, __FUNCTION__))->base.readonly_flag) = 1;
2181	DECL_INITIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2181, __FUNCTION__))->decl_common.initial) = init;
2182	init = tmp;
2183
2184	/* Use BUILTIN_MEMCPY to assign the values. */
2185	tmp = gfc_conv_descriptor_data_get (desc);
2186	tmp = build_fold_indirect_ref_loc (input_location,
2187	tmp);
2188	tmp = gfc_build_array_ref (tmp, *poffset, NULL__null);
2189	tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
2190	init = gfc_build_addr_expr (NULL_TREE(tree) __null, init);
2191
2192	size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type))((unsigned long) (*tree_int_cst_elt_check ((((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2192, __FUNCTION__))->type_common.size_unit)), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2192, __FUNCTION__)));
2193	bound = build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], n * size);
2194	tmp = build_call_expr_loc (input_location,
2195	builtin_decl_explicit (BUILT_IN_MEMCPY),
2196	3, tmp, init, bound);
2197	gfc_add_expr_to_block (&body, tmp);
2198
2199	*poffset = fold_build2_loc (input_location, PLUS_EXPR,
2200	gfc_array_index_type, *poffset,
2201	build_int_cst (gfc_array_index_type, n));
2202	}
2203	if (!INTEGER_CST_P (poffset)(((enum tree_code) (poffset)->base.code) == INTEGER_CST))
2204	{
2205	gfc_add_modify (&body, offsetvar, poffset);
2206	poffset = offsetvar;
2207	}
2208
2209	if (!c->iterator)
2210	ts = c->expr->ts;
2211	}
2212
2213	/* The frontend should already have done any expansions
2214	at compile-time. */
2215	if (!c->iterator)
2216	{
2217	/* Pass the code as is. */
2218	tmp = gfc_finish_block (&body);
2219	gfc_add_expr_to_block (pblock, tmp);
2220	}
2221	else
2222	{
2223	/* Build the implied do-loop. */
2224	stmtblock_t implied_do_block;
2225	tree cond;
2226	tree exit_label;
2227	tree loopbody;
2228	tree tmp2;
2229
2230	loopbody = gfc_finish_block (&body);
2231
2232	/* Create a new block that holds the implied-do loop. A temporary
2233	loop-variable is used. */
2234	gfc_start_block(&implied_do_block);
2235
2236	/* Initialize the loop. */
2237	gfc_add_modify (&implied_do_block, shadow_loopvar, start);
2238
2239	/* If this array expands dynamically, and the number of iterations
2240	is not constant, we won't have allocated space for the static
2241	part of C->EXPR's size. Do that now. */
2242	if (dynamic && gfc_iterator_has_dynamic_bounds (c->iterator))
2243	{
2244	/* Get the number of iterations. */
2245	tmp = gfc_get_iteration_count (shadow_loopvar, end, step);
2246
2247	/* Get the static part of C->EXPR's size. */
2248	gfc_get_array_constructor_element_size (&size, c->expr);
2249	tmp2 = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind);
2250
2251	/* Grow the array by TMP * TMP2 elements. */
2252	tmp = fold_build2_loc (input_location, MULT_EXPR,
2253	gfc_array_index_type, tmp, tmp2);
2254	gfc_grow_array (&implied_do_block, desc, tmp);
2255	}
2256
2257	/* Generate the loop body. */
2258	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2259	gfc_start_block (&body);
2260
2261	/* Generate the exit condition. Depending on the sign of
2262	the step variable we have to generate the correct
2263	comparison. */
2264	tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
2265	step, build_int_cst (TREE_TYPE (step)((contains_struct_check ((step), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2265, __FUNCTION__))->typed.type), 0));
2266	cond = fold_build3_loc (input_location, COND_EXPR,
2267	logical_type_node, tmp,
2268	fold_build2_loc (input_location, GT_EXPR,
2269	logical_type_node, shadow_loopvar, end),
2270	fold_build2_loc (input_location, LT_EXPR,
2271	logical_type_node, shadow_loopvar, end));
2272	tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2273	TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
2274	tmp = build3_v (COND_EXPR, cond, tmp,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, tmp, build_empty_stmt (input_location))
2275	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, tmp, build_empty_stmt (input_location));
2276	gfc_add_expr_to_block (&body, tmp);
2277
2278	/* The main loop body. */
2279	gfc_add_expr_to_block (&body, loopbody);
2280
2281	/* Increase loop variable by step. */
2282	tmp = fold_build2_loc (input_location, PLUS_EXPR,
2283	TREE_TYPE (shadow_loopvar)((contains_struct_check ((shadow_loopvar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2283, __FUNCTION__))->typed.type), shadow_loopvar,
2284	step);
2285	gfc_add_modify (&body, shadow_loopvar, tmp);
2286
2287	/* Finish the loop. */
2288	tmp = gfc_finish_block (&body);
2289	tmp = build1_v (LOOP_EXPR, tmp)fold_build1_loc (input_location, LOOP_EXPR, global_trees[TI_VOID_TYPE ], tmp);
2290	gfc_add_expr_to_block (&implied_do_block, tmp);
2291
2292	/* Add the exit label. */
2293	tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2294	gfc_add_expr_to_block (&implied_do_block, tmp);
2295
2296	/* Finish the implied-do loop. */
2297	tmp = gfc_finish_block(&implied_do_block);
2298	gfc_add_expr_to_block(pblock, tmp);
2299
2300	gfc_restore_sym (c->iterator->var->symtree->n.sym, &saved_loopvar);
2301	}
2302	}
2303
2304	/* F2008 4.5.6.3 para 5: If an executable construct references a structure
2305	constructor or array constructor, the entity created by the constructor is
2306	finalized after execution of the innermost executable construct containing
2307	the reference. This, in fact, was later deleted by the Combined Techical
2308	Corrigenda 1 TO 4 for fortran 2008 (f08/0011).
2309
2310	Transmit finalization of this constructor through 'finalblock'. */
2311	if (!gfc_notification_std (GFC_STD_F2018_DEL(1<<11)) && finalblock != NULL__null
2312	&& gfc_may_be_finalized (ts)
2313	&& ctr > 0 && desc != NULL_TREE(tree) __null
2314	&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2314, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2314, __FUNCTION__))->type_common.lang_flag_1))
2315	{
2316	symbol_attribute attr;
2317	gfc_se fse;
2318	gfc_warning (0, "The structure constructor at %C has been"
2319	" finalized. This feature was removed by f08/0011."
2320	" Use -std=f2018 or -std=gnu to eliminate the"
2321	" finalization.");
2322	attr.pointer = attr.allocatable = 0;
2323	gfc_init_se (&fse, NULL__null);
2324	fse.expr = desc;
2325	gfc_finalize_tree_expr (&fse, ts.u.derived, attr, 1);
2326	gfc_add_block_to_block (finalblock, &fse.pre);
2327	gfc_add_block_to_block (finalblock, &fse.finalblock);
2328	gfc_add_block_to_block (finalblock, &fse.post);
2329	}
2330
2331	mpz_clear__gmpz_clear (size);
2332	}
2333
2334
2335	/* The array constructor code can create a string length with an operand
2336	in the form of a temporary variable. This variable will retain its
2337	context (current_function_decl). If we store this length tree in a
2338	gfc_charlen structure which is shared by a variable in another
2339	context, the resulting gfc_charlen structure with a variable in a
2340	different context, we could trip the assertion in expand_expr_real_1
2341	when it sees that a variable has been created in one context and
2342	referenced in another.
2343
2344	If this might be the case, we create a new gfc_charlen structure and
2345	link it into the current namespace. */
2346
2347	static void
2348	store_backend_decl (gfc_charlen **clp, tree len, bool force_new_cl)
2349	{
2350	if (force_new_cl)
2351	{
2352	gfc_charlen new_cl = gfc_new_charlen (gfc_current_ns, clp);
2353	*clp = new_cl;
2354	}
2355	(*clp)->backend_decl = len;
2356	}
2357
2358	/* A catch-all to obtain the string length for anything that is not
2359	a substring of non-constant length, a constant, array or variable. */
2360
2361	static void
2362	get_array_ctor_all_strlen (stmtblock_t block, gfc_expr e, tree *len)
2363	{
2364	gfc_se se;
2365
2366	/* Don't bother if we already know the length is a constant. */
2367	if (len && INTEGER_CST_P (len)(((enum tree_code) (*len)->base.code) == INTEGER_CST))
2368	return;
2369
2370	if (!e->ref && e->ts.u.cl && e->ts.u.cl->length
2371	&& e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
2372	{
2373	/* This is easy. */
2374	gfc_conv_const_charlen (e->ts.u.cl);
2375	*len = e->ts.u.cl->backend_decl;
2376	}
2377	else
2378	{
2379	/* Otherwise, be brutal even if inefficient. */
2380	gfc_init_se (&se, NULL__null);
2381
2382	/* No function call, in case of side effects. */
2383	se.no_function_call = 1;
2384	if (e->rank == 0)
2385	gfc_conv_expr (&se, e);
2386	else
2387	gfc_conv_expr_descriptor (&se, e);
2388
2389	/* Fix the value. */
2390	*len = gfc_evaluate_now (se.string_length, &se.pre);
2391
2392	gfc_add_block_to_block (block, &se.pre);
2393	gfc_add_block_to_block (block, &se.post);
2394
2395	store_backend_decl (&e->ts.u.cl, *len, true);
2396	}
2397	}
2398
2399
2400	/* Figure out the string length of a variable reference expression.
2401	Used by get_array_ctor_strlen. */
2402
2403	static void
2404	get_array_ctor_var_strlen (stmtblock_t block, gfc_expr expr, tree * len)
2405	{
2406	gfc_ref *ref;
2407	gfc_typespec *ts;
2408	mpz_t char_len;
2409	gfc_se se;
2410
2411	/* Don't bother if we already know the length is a constant. */
2412	if (len && INTEGER_CST_P (len)(((enum tree_code) (*len)->base.code) == INTEGER_CST))
2413	return;
2414
2415	ts = &expr->symtree->n.sym->ts;
2416	for (ref = expr->ref; ref; ref = ref->next)
2417	{
2418	switch (ref->type)
2419	{
2420	case REF_ARRAY:
2421	/* Array references don't change the string length. */
2422	if (ts->deferred)
2423	get_array_ctor_all_strlen (block, expr, len);
2424	break;
2425
2426	case REF_COMPONENT:
2427	/* Use the length of the component. */
2428	ts = &ref->u.c.component->ts;
2429	break;
2430
2431	case REF_SUBSTRING:
2432	if (ref->u.ss.end == NULL__null
2433	\|\| ref->u.ss.start->expr_type != EXPR_CONSTANT
2434	\|\| ref->u.ss.end->expr_type != EXPR_CONSTANT)
2435	{
2436	/* Note that this might evaluate expr. */
2437	get_array_ctor_all_strlen (block, expr, len);
2438	return;
2439	}
2440	mpz_init_set_ui__gmpz_init_set_ui (char_len, 1);
2441	mpz_add__gmpz_add (char_len, char_len, ref->u.ss.end->value.integer);
2442	mpz_sub__gmpz_sub (char_len, char_len, ref->u.ss.start->value.integer);
2443	*len = gfc_conv_mpz_to_tree_type (char_len, gfc_charlen_type_node);
2444	mpz_clear__gmpz_clear (char_len);
2445	return;
2446
2447	case REF_INQUIRY:
2448	break;
2449
2450	default:
2451	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2451, __FUNCTION__));
2452	}
2453	}
2454
2455	/* A last ditch attempt that is sometimes needed for deferred characters. */
2456	if (!ts->u.cl->backend_decl)
2457	{
2458	gfc_init_se (&se, NULL__null);
2459	if (expr->rank)
2460	gfc_conv_expr_descriptor (&se, expr);
2461	else
2462	gfc_conv_expr (&se, expr);
2463	gcc_assert (se.string_length != NULL_TREE)((void)(!(se.string_length != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2463, __FUNCTION__), 0 : 0));
2464	gfc_add_block_to_block (block, &se.pre);
2465	ts->u.cl->backend_decl = se.string_length;
2466	}
2467
2468	*len = ts->u.cl->backend_decl;
2469	}
2470
2471
2472	/* Figure out the string length of a character array constructor.
2473	If len is NULL, don't calculate the length; this happens for recursive calls
2474	when a sub-array-constructor is an element but not at the first position,
2475	so when we're not interested in the length.
2476	Returns TRUE if all elements are character constants. */
2477
2478	bool
2479	get_array_ctor_strlen (stmtblock_t block, gfc_constructor_base base, tree len)
2480	{
2481	gfc_constructor *c;
2482	bool is_const;
2483
2484	is_const = TRUEtrue;
2485
2486	if (gfc_constructor_first (base) == NULL__null)
2487	{
2488	if (len)
2489	*len = build_int_cstu (gfc_charlen_type_node, 0);
2490	return is_const;
2491	}
2492
2493	/* Loop over all constructor elements to find out is_const, but in len we
2494	want to store the length of the first, not the last, element. We can
2495	of course exit the loop as soon as is_const is found to be false. */
2496	for (c = gfc_constructor_first (base);
2497	c && is_const; c = gfc_constructor_next (c))
2498	{
2499	switch (c->expr->expr_type)
2500	{
2501	case EXPR_CONSTANT:
2502	if (len && !(len && INTEGER_CST_P (len)(((enum tree_code) (*len)->base.code) == INTEGER_CST)))
2503	*len = build_int_cstu (gfc_charlen_type_node,
2504	c->expr->value.character.length);
2505	break;
2506
2507	case EXPR_ARRAY:
2508	if (!get_array_ctor_strlen (block, c->expr->value.constructor, len))
2509	is_const = false;
2510	break;
2511
2512	case EXPR_VARIABLE:
2513	is_const = false;
2514	if (len)
2515	get_array_ctor_var_strlen (block, c->expr, len);
2516	break;
2517
2518	default:
2519	is_const = false;
2520	if (len)
2521	get_array_ctor_all_strlen (block, c->expr, len);
2522	break;
2523	}
2524
2525	/* After the first iteration, we don't want the length modified. */
2526	len = NULL__null;
2527	}
2528
2529	return is_const;
2530	}
2531
2532	/* Check whether the array constructor C consists entirely of constant
2533	elements, and if so returns the number of those elements, otherwise
2534	return zero. Note, an empty or NULL array constructor returns zero. */
2535
2536	unsigned HOST_WIDE_INTlong
2537	gfc_constant_array_constructor_p (gfc_constructor_base base)
2538	{
2539	unsigned HOST_WIDE_INTlong nelem = 0;
2540
2541	gfc_constructor *c = gfc_constructor_first (base);
2542	while (c)
2543	{
2544	if (c->iterator
2545	\|\| c->expr->rank > 0
2546	\|\| c->expr->expr_type != EXPR_CONSTANT)
2547	return 0;
2548	c = gfc_constructor_next (c);
2549	nelem++;
2550	}
2551	return nelem;
2552	}
2553
2554
2555	/* Given EXPR, the constant array constructor specified by an EXPR_ARRAY,
2556	and the tree type of it's elements, TYPE, return a static constant
2557	variable that is compile-time initialized. */
2558
2559	tree
2560	gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
2561	{
2562	tree tmptype, init, tmp;
2563	HOST_WIDE_INTlong nelem;
2564	gfc_constructor *c;
2565	gfc_array_spec as;
2566	gfc_se se;
2567	int i;
2568	vec<constructor_elt, va_gc> *v = NULL__null;
2569
2570	/* First traverse the constructor list, converting the constants
2571	to tree to build an initializer. */
2572	nelem = 0;
2573	c = gfc_constructor_first (expr->value.constructor);
2574	while (c)
2575	{
2576	gfc_init_se (&se, NULL__null);
2577	gfc_conv_constant (&se, c->expr);
2578	if (c->expr->ts.type != BT_CHARACTER)
2579	se.expr = fold_convert (type, se.expr)fold_convert_loc (((location_t) 0), type, se.expr);
2580	else if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE \|\| ( (enum tree_code) (type)->base.code) == REFERENCE_TYPE))
2581	se.expr = gfc_build_addr_expr (gfc_get_pchar_type (c->expr->ts.kind),
2582	se.expr);
2583	CONSTRUCTOR_APPEND_ELT (v, build_int_cst (gfc_array_index_type, nelem),do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type , nelem), se.expr}; vec_safe_push ((v), _ce___); } while (0)
2584	se.expr)do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type , nelem), se.expr}; vec_safe_push ((v), _ce___); } while (0);
2585	c = gfc_constructor_next (c);
2586	nelem++;
2587	}
2588
2589	/* Next determine the tree type for the array. We use the gfortran
2590	front-end's gfc_get_nodesc_array_type in order to create a suitable
2591	GFC_ARRAY_TYPE_P that may be used by the scalarizer. */
2592
2593	memset (&as, 0, sizeof (gfc_array_spec));
2594
2595	as.rank = expr->rank;
2596	as.type = AS_EXPLICIT;
2597	if (!expr->shape)
2598	{
2599	as.lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL__null, 0);
2600	as.upper[0] = gfc_get_int_expr (gfc_default_integer_kind,
2601	NULL__null, nelem - 1);
2602	}
2603	else
2604	for (i = 0; i < expr->rank; i++)
2605	{
2606	int tmp = (int) mpz_get_si__gmpz_get_si (expr->shape[i]);
2607	as.lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL__null, 0);
2608	as.upper[i] = gfc_get_int_expr (gfc_default_integer_kind,
2609	NULL__null, tmp - 1);
2610	}
2611
2612	tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
2613
2614	/* as is not needed anymore. */
2615	for (i = 0; i < as.rank + as.corank; i++)
2616	{
2617	gfc_free_expr (as.lower[i]);
2618	gfc_free_expr (as.upper[i]);
2619	}
2620
2621	init = build_constructor (tmptype, v);
2622
2623	TREE_CONSTANT (init)((non_type_check ((init), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2623, __FUNCTION__))->base.constant_flag) = 1;
2624	TREE_STATIC (init)((init)->base.static_flag) = 1;
2625
2626	tmp = build_decl (input_location, VAR_DECL, create_tmp_var_name ("A"),
2627	tmptype);
2628	DECL_ARTIFICIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2628, __FUNCTION__))->decl_common.artificial_flag) = 1;
2629	DECL_IGNORED_P (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2629, __FUNCTION__))->decl_common.ignored_flag) = 1;
2630	TREE_STATIC (tmp)((tmp)->base.static_flag) = 1;
2631	TREE_CONSTANT (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2631, __FUNCTION__))->base.constant_flag) = 1;
2632	TREE_READONLY (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2632, __FUNCTION__))->base.readonly_flag) = 1;
2633	DECL_INITIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2633, __FUNCTION__))->decl_common.initial) = init;
2634	pushdecl (tmp);
2635
2636	return tmp;
2637	}
2638
2639
2640	/* Translate a constant EXPR_ARRAY array constructor for the scalarizer.
2641	This mostly initializes the scalarizer state info structure with the
2642	appropriate values to directly use the array created by the function
2643	gfc_build_constant_array_constructor. */
2644
2645	static void
2646	trans_constant_array_constructor (gfc_ss * ss, tree type)
2647	{
2648	gfc_array_info *info;
2649	tree tmp;
2650	int i;
2651
2652	tmp = gfc_build_constant_array_constructor (ss->info->expr, type);
2653
2654	info = &ss->info->data.array;
2655
2656	info->descriptor = tmp;
2657	info->data = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
2658	info->offset = gfc_index_zero_nodegfc_rank_cst[0];
2659
2660	for (i = 0; i < ss->dimen; i++)
2661	{
2662	info->delta[i] = gfc_index_zero_nodegfc_rank_cst[0];
2663	info->start[i] = gfc_index_zero_nodegfc_rank_cst[0];
2664	info->end[i] = gfc_index_zero_nodegfc_rank_cst[0];
2665	info->stride[i] = gfc_index_one_nodegfc_rank_cst[1];
2666	}
2667	}
2668
2669
2670	static int
2671	get_rank (gfc_loopinfo *loop)
2672	{
2673	int rank;
2674
2675	rank = 0;
2676	for (; loop; loop = loop->parent)
2677	rank += loop->dimen;
2678
2679	return rank;
2680	}
2681
2682
2683	/* Helper routine of gfc_trans_array_constructor to determine if the
2684	bounds of the loop specified by LOOP are constant and simple enough
2685	to use with trans_constant_array_constructor. Returns the
2686	iteration count of the loop if suitable, and NULL_TREE otherwise. */
2687
2688	static tree
2689	constant_array_constructor_loop_size (gfc_loopinfo * l)
2690	{
2691	gfc_loopinfo *loop;
2692	tree size = gfc_index_one_nodegfc_rank_cst[1];
2693	tree tmp;
2694	int i, total_dim;
2695
2696	total_dim = get_rank (l);
2697
2698	for (loop = l; loop; loop = loop->parent)
2699	{
2700	for (i = 0; i < loop->dimen; i++)
2701	{
2702	/* If the bounds aren't constant, return NULL_TREE. */
2703	if (!INTEGER_CST_P (loop->from[i])(((enum tree_code) (loop->from[i])->base.code) == INTEGER_CST ) \|\| !INTEGER_CST_P (loop->to[i])(((enum tree_code) (loop->to[i])->base.code) == INTEGER_CST ))
2704	return NULL_TREE(tree) __null;
2705	if (!integer_zerop (loop->from[i]))
2706	{
2707	/* Only allow nonzero "from" in one-dimensional arrays. */
2708	if (total_dim != 1)
2709	return NULL_TREE(tree) __null;
2710	tmp = fold_build2_loc (input_location, MINUS_EXPR,
2711	gfc_array_index_type,
2712	loop->to[i], loop->from[i]);
2713	}
2714	else
2715	tmp = loop->to[i];
2716	tmp = fold_build2_loc (input_location, PLUS_EXPR,
2717	gfc_array_index_type, tmp, gfc_index_one_nodegfc_rank_cst[1]);
2718	size = fold_build2_loc (input_location, MULT_EXPR,
2719	gfc_array_index_type, size, tmp);
2720	}
2721	}
2722
2723	return size;
2724	}
2725
2726
2727	static tree *
2728	get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
2729	{
2730	gfc_ss *ss;
2731	int n;
2732
2733	gcc_assert (array->nested_ss == NULL)((void)(!(array->nested_ss == __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2733, __FUNCTION__), 0 : 0));
2734
2735	for (ss = array; ss; ss = ss->parent)
2736	for (n = 0; n < ss->loop->dimen; n++)
2737	if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
2738	return &(ss->loop->to[n]);
2739
2740	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2740, __FUNCTION__));
2741	}
2742
2743
2744	static gfc_loopinfo *
2745	outermost_loop (gfc_loopinfo * loop)
2746	{
2747	while (loop->parent != NULL__null)
2748	loop = loop->parent;
2749
2750	return loop;
2751	}
2752
2753
2754	/* Array constructors are handled by constructing a temporary, then using that
2755	within the scalarization loop. This is not optimal, but seems by far the
2756	simplest method. */
2757
2758	static void
2759	trans_array_constructor (gfc_ss * ss, locus * where)
2760	{
2761	gfc_constructor_base c;
2762	tree offset;
2763	tree offsetvar;
2764	tree desc;
2765	tree type;
2766	tree tmp;
2767	tree *loop_ubound0;
2768	bool dynamic;
2769	bool old_first_len, old_typespec_chararray_ctor;
2770	tree old_first_len_val;
2771	gfc_loopinfo loop, outer_loop;
2772	gfc_ss_info *ss_info;
2773	gfc_expr *expr;
2774	gfc_ss *s;
2775	tree neg_len;
2776	char *msg;
2777	stmtblock_t finalblock;
2778
2779	/* Save the old values for nested checking. */
2780	old_first_len = first_len;
2781	old_first_len_val = first_len_val;
2782	old_typespec_chararray_ctor = typespec_chararray_ctor;
2783
2784	loop = ss->loop;
2785	outer_loop = outermost_loop (loop);
2786	ss_info = ss->info;
2787	expr = ss_info->expr;
2788
2789	/* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
2790	typespec was given for the array constructor. */
2791	typespec_chararray_ctor = (expr->ts.type == BT_CHARACTER
2792	&& expr->ts.u.cl
2793	&& expr->ts.u.cl->length_from_typespec);
2794
2795	if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
2796	&& expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
2797	{
2798	first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
2799	first_len = true;
2800	}
2801
2802	gcc_assert (ss->dimen == ss->loop->dimen)((void)(!(ss->dimen == ss->loop->dimen) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2802, __FUNCTION__), 0 : 0));
2803
2804	c = expr->value.constructor;
2805	if (expr->ts.type == BT_CHARACTER)
2806	{
2807	bool const_string;
2808	bool force_new_cl = false;
2809
2810	/* get_array_ctor_strlen walks the elements of the constructor, if a
2811	typespec was given, we already know the string length and want the one
2812	specified there. */
2813	if (typespec_chararray_ctor && expr->ts.u.cl->length
2814	&& expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
2815	{
2816	gfc_se length_se;
2817
2818	const_string = false;
2819	gfc_init_se (&length_se, NULL__null);
2820	gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
2821	gfc_charlen_type_node);
2822	ss_info->string_length = length_se.expr;
2823
2824	/* Check if the character length is negative. If it is, then
2825	set LEN = 0. */
2826	neg_len = fold_build2_loc (input_location, LT_EXPR,
2827	logical_type_node, ss_info->string_length,
2828	build_zero_cst (TREE_TYPE((contains_struct_check ((ss_info->string_length), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2829, __FUNCTION__))->typed.type)
2829	(ss_info->string_length)((contains_struct_check ((ss_info->string_length), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2829, __FUNCTION__))->typed.type)));
2830	/* Print a warning if bounds checking is enabled. */
2831	if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
2832	{
2833	msg = xasprintf ("Negative character length treated as LEN = 0");
2834	gfc_trans_runtime_check (false, true, neg_len, &length_se.pre,
2835	where, msg);
2836	free (msg);
2837	}
2838
2839	ss_info->string_length
2840	= fold_build3_loc (input_location, COND_EXPR,
2841	gfc_charlen_type_node, neg_len,
2842	build_zero_cst
2843	(TREE_TYPE (ss_info->string_length)((contains_struct_check ((ss_info->string_length), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2843, __FUNCTION__))->typed.type)),
2844	ss_info->string_length);
2845	ss_info->string_length = gfc_evaluate_now (ss_info->string_length,
2846	&length_se.pre);
2847	gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
2848	gfc_add_block_to_block (&outer_loop->post, &length_se.post);
2849	}
2850	else
2851	{
2852	const_string = get_array_ctor_strlen (&outer_loop->pre, c,
2853	&ss_info->string_length);
2854	force_new_cl = true;
2855	}
2856
2857	/* Complex character array constructors should have been taken care of
2858	and not end up here. */
2859	gcc_assert (ss_info->string_length)((void)(!(ss_info->string_length) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2859, __FUNCTION__), 0 : 0));
2860
2861	store_backend_decl (&expr->ts.u.cl, ss_info->string_length, force_new_cl);
2862
2863	type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length);
2864	if (const_string)
2865	type = build_pointer_type (type);
2866	}
2867	else
2868	type = gfc_typenode_for_spec (expr->ts.type == BT_CLASS
2869	? &CLASS_DATA (expr)expr->ts.u.derived->components->ts : &expr->ts);
2870
2871	/* See if the constructor determines the loop bounds. */
2872	dynamic = false;
2873
2874	loop_ubound0 = get_loop_upper_bound_for_array (ss, 0);
2875
2876	if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE(tree) __null)
2877	{
2878	/* We have a multidimensional parameter. */
2879	for (s = ss; s; s = s->parent)
2880	{
2881	int n;
2882	for (n = 0; n < s->loop->dimen; n++)
2883	{
2884	s->loop->from[n] = gfc_index_zero_nodegfc_rank_cst[0];
2885	s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]],
2886	gfc_index_integer_kind);
2887	s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
2888	gfc_array_index_type,
2889	s->loop->to[n],
2890	gfc_index_one_nodegfc_rank_cst[1]);
2891	}
2892	}
2893	}
2894
2895	if (*loop_ubound0 == NULL_TREE(tree) __null)
2896	{
2897	mpz_t size;
2898
2899	/* We should have a 1-dimensional, zero-based loop. */
2900	gcc_assert (loop->parent == NULL && loop->nested == NULL)((void)(!(loop->parent == __null && loop->nested == __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2900, __FUNCTION__), 0 : 0));
2901	gcc_assert (loop->dimen == 1)((void)(!(loop->dimen == 1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2901, __FUNCTION__), 0 : 0));
2902	gcc_assert (integer_zerop (loop->from[0]))((void)(!(integer_zerop (loop->from[0])) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2902, __FUNCTION__), 0 : 0));
2903
2904	/* Split the constructor size into a static part and a dynamic part.
2905	Allocate the static size up-front and record whether the dynamic
2906	size might be nonzero. */
2907	mpz_init__gmpz_init (size);
2908	dynamic = gfc_get_array_constructor_size (&size, c);
2909	mpz_sub_ui__gmpz_sub_ui (size, size, 1);
2910	loop->to[0] = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind);
2911	mpz_clear__gmpz_clear (size);
2912	}
2913
2914	/* Special case constant array constructors. */
2915	if (!dynamic)
2916	{
2917	unsigned HOST_WIDE_INTlong nelem = gfc_constant_array_constructor_p (c);
2918	if (nelem > 0)
2919	{
2920	tree size = constant_array_constructor_loop_size (loop);
2921	if (size && compare_tree_int (size, nelem) == 0)
2922	{
2923	trans_constant_array_constructor (ss, type);
2924	goto finish;
2925	}
2926	}
2927	}
2928
2929	gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
2930	NULL_TREE(tree) __null, dynamic, true, false, where);
2931
2932	desc = ss_info->data.array.descriptor;
2933	offset = gfc_index_zero_nodegfc_rank_cst[0];
2934	offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
2935	suppress_warning (offsetvar);
2936	TREE_USED (offsetvar)((offsetvar)->base.used_flag) = 0;
2937
2938	gfc_init_block (&finalblock);
2939	gfc_trans_array_constructor_value (&outer_loop->pre,
2940	expr->must_finalize ? &finalblock : NULL__null,
2941	type, desc, c, &offset, &offsetvar,
2942	dynamic);
2943
2944	/* If the array grows dynamically, the upper bound of the loop variable
2945	is determined by the array's final upper bound. */
2946	if (dynamic)
2947	{
2948	tmp = fold_build2_loc (input_location, MINUS_EXPR,
2949	gfc_array_index_type,
2950	offsetvar, gfc_index_one_nodegfc_rank_cst[1]);
2951	tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
2952	gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
2953	if (loop_ubound0 && VAR_P (loop_ubound0)(((enum tree_code) (*loop_ubound0)->base.code) == VAR_DECL ))
2954	gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
2955	else
2956	*loop_ubound0 = tmp;
2957	}
2958
2959	if (TREE_USED (offsetvar)((offsetvar)->base.used_flag))
2960	pushdecl (offsetvar);
2961	else
2962	gcc_assert (INTEGER_CST_P (offset))((void)(!((((enum tree_code) (offset)->base.code) == INTEGER_CST )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2962, __FUNCTION__), 0 : 0));
2963
2964	#if 0
2965	/* Disable bound checking for now because it's probably broken. */
2966	if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
2967	{
2968	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 2968, __FUNCTION__));
2969	}
2970	#endif
2971
2972	finish:
2973	/* Restore old values of globals. */
2974	first_len = old_first_len;
2975	first_len_val = old_first_len_val;
2976	typespec_chararray_ctor = old_typespec_chararray_ctor;
2977
2978	/* F2008 4.5.6.3 para 5: If an executable construct references a structure
2979	constructor or array constructor, the entity created by the constructor is
2980	finalized after execution of the innermost executable construct containing
2981	the reference. */
2982	if ((expr->ts.type == BT_DERIVED \|\| expr->ts.type == BT_CLASS)
2983	&& finalblock.head != NULL_TREE(tree) __null)
2984	gfc_add_block_to_block (&loop->post, &finalblock);
2985
2986	}
2987
2988
2989	/* INFO describes a GFC_SS_SECTION in loop LOOP, and this function is
2990	called after evaluating all of INFO's vector dimensions. Go through
2991	each such vector dimension and see if we can now fill in any missing
2992	loop bounds. */
2993
2994	static void
2995	set_vector_loop_bounds (gfc_ss * ss)
2996	{
2997	gfc_loopinfo loop, outer_loop;
2998	gfc_array_info *info;
2999	gfc_se se;
3000	tree tmp;
3001	tree desc;
3002	tree zero;
3003	int n;
3004	int dim;
3005
3006	outer_loop = outermost_loop (ss->loop);
3007
3008	info = &ss->info->data.array;
3009
3010	for (; ss; ss = ss->parent)
3011	{
3012	loop = ss->loop;
3013
3014	for (n = 0; n < loop->dimen; n++)
3015	{
3016	dim = ss->dim[n];
3017	if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR
3018	\|\| loop->to[n] != NULL__null)
3019	continue;
3020
3021	/* Loop variable N indexes vector dimension DIM, and we don't
3022	yet know the upper bound of loop variable N. Set it to the
3023	difference between the vector's upper and lower bounds. */
3024	gcc_assert (loop->from[n] == gfc_index_zero_node)((void)(!(loop->from[n] == gfc_rank_cst[0]) ? fancy_abort ( "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3024, __FUNCTION__), 0 : 0));
3025	gcc_assert (info->subscript[dim]((void)(!(info->subscript[dim] && info->subscript [dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3026, __FUNCTION__), 0 : 0))
3026	&& info->subscript[dim]->info->type == GFC_SS_VECTOR)((void)(!(info->subscript[dim] && info->subscript [dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3026, __FUNCTION__), 0 : 0));
3027
3028	gfc_init_se (&se, NULL__null);
3029	desc = info->subscript[dim]->info->data.array.descriptor;
3030	zero = gfc_rank_cst[0];
3031	tmp = fold_build2_loc (input_location, MINUS_EXPR,
3032	gfc_array_index_type,
3033	gfc_conv_descriptor_ubound_get (desc, zero),
3034	gfc_conv_descriptor_lbound_get (desc, zero));
3035	tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
3036	loop->to[n] = tmp;
3037	}
3038	}
3039	}
3040
3041
3042	/* Tells whether a scalar argument to an elemental procedure is saved out
3043	of a scalarization loop as a value or as a reference. */
3044
3045	bool
3046	gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
3047	{
3048	if (ss_info->type != GFC_SS_REFERENCE)
3049	return false;
3050
3051	if (ss_info->data.scalar.needs_temporary)
3052	return false;
3053
3054	/* If the actual argument can be absent (in other words, it can
3055	be a NULL reference), don't try to evaluate it; pass instead
3056	the reference directly. */
3057	if (ss_info->can_be_null_ref)
3058	return true;
3059
3060	/* If the expression is of polymorphic type, it's actual size is not known,
3061	so we avoid copying it anywhere. */
3062	if (ss_info->data.scalar.dummy_arg
3063	&& gfc_dummy_arg_get_typespec (*ss_info->data.scalar.dummy_arg).type
3064	== BT_CLASS
3065	&& ss_info->expr->ts.type == BT_CLASS)
3066	return true;
3067
3068	/* If the expression is a data reference of aggregate type,
3069	and the data reference is not used on the left hand side,
3070	avoid a copy by saving a reference to the content. */
3071	if (!ss_info->data.scalar.needs_temporary
3072	&& (ss_info->expr->ts.type == BT_DERIVED
3073	\|\| ss_info->expr->ts.type == BT_CLASS)
3074	&& gfc_expr_is_variable (ss_info->expr))
3075	return true;
3076
3077	/* Otherwise the expression is evaluated to a temporary variable before the
3078	scalarization loop. */
3079	return false;
3080	}
3081
3082
3083	/* Add the pre and post chains for all the scalar expressions in a SS chain
3084	to loop. This is called after the loop parameters have been calculated,
3085	but before the actual scalarizing loops. */
3086
3087	static void
3088	gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
3089	locus * where)
3090	{
3091	gfc_loopinfo nested_loop, outer_loop;
3092	gfc_se se;
3093	gfc_ss_info *ss_info;
3094	gfc_array_info *info;
3095	gfc_expr *expr;
3096	int n;
3097
3098	/* Don't evaluate the arguments for realloc_lhs_loop_for_fcn_call; otherwise,
3099	arguments could get evaluated multiple times. */
3100	if (ss->is_alloc_lhs)
3101	return;
3102
3103	outer_loop = outermost_loop (loop);
3104
3105	/* TODO: This can generate bad code if there are ordering dependencies,
3106	e.g., a callee allocated function and an unknown size constructor. */
3107	gcc_assert (ss != NULL)((void)(!(ss != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3107, __FUNCTION__), 0 : 0));
3108
3109	for (; ss != gfc_ss_terminator; ss = ss->loop_chain)
3110	{
3111	gcc_assert (ss)((void)(!(ss) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3111, __FUNCTION__), 0 : 0));
3112
3113	/* Cross loop arrays are handled from within the most nested loop. */
3114	if (ss->nested_ss != NULL__null)
3115	continue;
3116
3117	ss_info = ss->info;
3118	expr = ss_info->expr;
3119	info = &ss_info->data.array;
3120
3121	switch (ss_info->type)
3122	{
3123	case GFC_SS_SCALAR:
3124	/* Scalar expression. Evaluate this now. This includes elemental
3125	dimension indices, but not array section bounds. */
3126	gfc_init_se (&se, NULL__null);
3127	gfc_conv_expr (&se, expr);
3128	gfc_add_block_to_block (&outer_loop->pre, &se.pre);
3129
3130	if (expr->ts.type != BT_CHARACTER
3131	&& !gfc_is_alloc_class_scalar_function (expr))
3132	{
3133	/* Move the evaluation of scalar expressions outside the
3134	scalarization loop, except for WHERE assignments. */
3135	if (subscript)
3136	se.expr = convert(gfc_array_index_type, se.expr);
3137	if (!ss_info->where)
3138	se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
3139	gfc_add_block_to_block (&outer_loop->pre, &se.post);
3140	}
3141	else
3142	gfc_add_block_to_block (&outer_loop->post, &se.post);
3143
3144	ss_info->data.scalar.value = se.expr;
3145	ss_info->string_length = se.string_length;
3146	break;
3147
3148	case GFC_SS_REFERENCE:
3149	/* Scalar argument to elemental procedure. */
3150	gfc_init_se (&se, NULL__null);
3151	if (gfc_scalar_elemental_arg_saved_as_reference (ss_info))
3152	gfc_conv_expr_reference (&se, expr);
3153	else
3154	{
3155	/* Evaluate the argument outside the loop and pass
3156	a reference to the value. */
3157	gfc_conv_expr (&se, expr);
3158	}
3159
3160	/* Ensure that a pointer to the string is stored. */
3161	if (expr->ts.type == BT_CHARACTER)
3162	gfc_conv_string_parameter (&se);
3163
3164	gfc_add_block_to_block (&outer_loop->pre, &se.pre);
3165	gfc_add_block_to_block (&outer_loop->post, &se.post);
3166	if (gfc_is_class_scalar_expr (expr))
3167	/* This is necessary because the dynamic type will always be
3168	large than the declared type. In consequence, assigning
3169	the value to a temporary could segfault.
3170	OOP-TODO: see if this is generally correct or is the value
3171	has to be written to an allocated temporary, whose address
3172	is passed via ss_info. */
3173	ss_info->data.scalar.value = se.expr;
3174	else
3175	ss_info->data.scalar.value = gfc_evaluate_now (se.expr,
3176	&outer_loop->pre);
3177
3178	ss_info->string_length = se.string_length;
3179	break;
3180
3181	case GFC_SS_SECTION:
3182	/* Add the expressions for scalar and vector subscripts. */
3183	for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
3184	if (info->subscript[n])
3185	gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
3186
3187	set_vector_loop_bounds (ss);
3188	break;
3189
3190	case GFC_SS_VECTOR:
3191	/* Get the vector's descriptor and store it in SS. */
3192	gfc_init_se (&se, NULL__null);
3193	gfc_conv_expr_descriptor (&se, expr);
3194	gfc_add_block_to_block (&outer_loop->pre, &se.pre);
3195	gfc_add_block_to_block (&outer_loop->post, &se.post);
3196	info->descriptor = se.expr;
3197	break;
3198
3199	case GFC_SS_INTRINSIC:
3200	gfc_add_intrinsic_ss_code (loop, ss);
3201	break;
3202
3203	case GFC_SS_FUNCTION:
3204	/* Array function return value. We call the function and save its
3205	result in a temporary for use inside the loop. */
3206	gfc_init_se (&se, NULL__null);
3207	se.loop = loop;
3208	se.ss = ss;
3209	if (gfc_is_class_array_function (expr))
3210	expr->must_finalize = 1;
3211	gfc_conv_expr (&se, expr);
3212	gfc_add_block_to_block (&outer_loop->pre, &se.pre);
3213	gfc_add_block_to_block (&outer_loop->post, &se.post);
3214	gfc_add_block_to_block (&outer_loop->post, &se.finalblock);
3215	ss_info->string_length = se.string_length;
3216	break;
3217
3218	case GFC_SS_CONSTRUCTOR:
3219	if (expr->ts.type == BT_CHARACTER
3220	&& ss_info->string_length == NULL__null
3221	&& expr->ts.u.cl
3222	&& expr->ts.u.cl->length
3223	&& expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
3224	{
3225	gfc_init_se (&se, NULL__null);
3226	gfc_conv_expr_type (&se, expr->ts.u.cl->length,
3227	gfc_charlen_type_node);
3228	ss_info->string_length = se.expr;
3229	gfc_add_block_to_block (&outer_loop->pre, &se.pre);
3230	gfc_add_block_to_block (&outer_loop->post, &se.post);
3231	}
3232	trans_array_constructor (ss, where);
3233	break;
3234
3235	case GFC_SS_TEMP:
3236	case GFC_SS_COMPONENT:
3237	/* Do nothing. These are handled elsewhere. */
3238	break;
3239
3240	default:
3241	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3241, __FUNCTION__));
3242	}
3243	}
3244
3245	if (!subscript)
3246	for (nested_loop = loop->nested; nested_loop;
3247	nested_loop = nested_loop->next)
3248	gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where);
3249	}
3250
3251
3252	/* Translate expressions for the descriptor and data pointer of a SS. */
3253	/GCC ARRAYS/
3254
3255	static void
3256	gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
3257	{
3258	gfc_se se;
3259	gfc_ss_info *ss_info;
3260	gfc_array_info *info;
3261	tree tmp;
3262
3263	ss_info = ss->info;
3264	info = &ss_info->data.array;
3265
3266	/* Get the descriptor for the array to be scalarized. */
3267	gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE)((void)(!(ss_info->expr->expr_type == EXPR_VARIABLE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3267, __FUNCTION__), 0 : 0));
3268	gfc_init_se (&se, NULL__null);
3269	se.descriptor_only = 1;
3270	gfc_conv_expr_lhs (&se, ss_info->expr);
3271	gfc_add_block_to_block (block, &se.pre);
3272	info->descriptor = se.expr;
3273	ss_info->string_length = se.string_length;
3274
3275	if (base)
3276	{
3277	if (ss_info->expr->ts.type == BT_CHARACTER && !ss_info->expr->ts.deferred
3278	&& ss_info->expr->ts.u.cl->length == NULL__null)
3279	{
3280	/* Emit a DECL_EXPR for the variable sized array type in
3281	GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
3282	sizes works correctly. */
3283	tree arraytype = TREE_TYPE (((contains_struct_check (((((tree_class_check ((((contains_struct_check ((info->descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3284, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3284, __FUNCTION__))->type_with_lang_specific.lang_specific )->dataptr_type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3284, __FUNCTION__))->typed.type)
3284	GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (info->descriptor)))((contains_struct_check (((((tree_class_check ((((contains_struct_check ((info->descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3284, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3284, __FUNCTION__))->type_with_lang_specific.lang_specific )->dataptr_type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3284, __FUNCTION__))->typed.type);
3285	if (! TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3285, __FUNCTION__))->type_common.name))
3286	TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3286, __FUNCTION__))->type_common.name) = build_decl (UNKNOWN_LOCATION((location_t) 0), TYPE_DECL,
3287	NULL_TREE(tree) __null, arraytype);
3288	gfc_add_expr_to_block (block, build1 (DECL_EXPR, arraytype,
3289	TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3289, __FUNCTION__))->type_common.name)));
3290	}
3291	/* Also the data pointer. */
3292	tmp = gfc_conv_array_data (se.expr);
3293	/* If this is a variable or address or a class array, use it directly.
3294	Otherwise we must evaluate it now to avoid breaking dependency
3295	analysis by pulling the expressions for elemental array indices
3296	inside the loop. */
3297	if (!(DECL_P (tmp)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (tmp)->base.code))] == tcc_declaration)
3298	\|\| (TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == ADDR_EXPR
3299	&& DECL_P (TREE_OPERAND (tmp, 0))(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) ((((const_cast<tree> (tree_operand_check ((tmp), (0 ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3299, __FUNCTION__))))))->base.code))] == tcc_declaration ))
3300	\|\| (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))((tree_class_check ((((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3300, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3300, __FUNCTION__))->type_common.lang_flag_1)
3301	&& TREE_CODE (se.expr)((enum tree_code) (se.expr)->base.code) == COMPONENT_REF
3302	&& GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (se.expr, 0)))((tree_class_check ((((contains_struct_check (((((const_cast <tree> (tree_operand_check ((se.expr), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3302, __FUNCTION__)))))), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3302, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3302, __FUNCTION__))->type_common.lang_flag_4))))
3303	tmp = gfc_evaluate_now (tmp, block);
3304	info->data = tmp;
3305
3306	tmp = gfc_conv_array_offset (se.expr);
3307	info->offset = gfc_evaluate_now (tmp, block);
3308
3309	/* Make absolutely sure that the saved_offset is indeed saved
3310	so that the variable is still accessible after the loops
3311	are translated. */
3312	info->saved_offset = info->offset;
3313	}
3314	}
3315
3316
3317	/* Initialize a gfc_loopinfo structure. */
3318
3319	void
3320	gfc_init_loopinfo (gfc_loopinfo * loop)
3321	{
3322	int n;
3323
3324	memset (loop, 0, sizeof (gfc_loopinfo));
3325	gfc_init_block (&loop->pre);
3326	gfc_init_block (&loop->post);
3327
3328	/* Initially scalarize in order and default to no loop reversal. */
3329	for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
3330	{
3331	loop->order[n] = n;
3332	loop->reverse[n] = GFC_INHIBIT_REVERSE;
3333	}
3334
3335	loop->ss = gfc_ss_terminator;
3336	}
3337
3338
3339	/* Copies the loop variable info to a gfc_se structure. Does not copy the SS
3340	chain. */
3341
3342	void
3343	gfc_copy_loopinfo_to_se (gfc_se * se, gfc_loopinfo * loop)
3344	{
3345	se->loop = loop;
3346	}
3347
3348
3349	/* Return an expression for the data pointer of an array. */
3350
3351	tree
3352	gfc_conv_array_data (tree descriptor)
3353	{
3354	tree type;
3355
3356	type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3356, __FUNCTION__))->typed.type);
3357	if (GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3357, __FUNCTION__))->type_common.lang_flag_2))
3358	{
3359	if (TREE_CODE (type)((enum tree_code) (type)->base.code) == POINTER_TYPE)
3360	return descriptor;
3361	else
3362	{
3363	/* Descriptorless arrays. */
3364	return gfc_build_addr_expr (NULL_TREE(tree) __null, descriptor);
3365	}
3366	}
3367	else
3368	return gfc_conv_descriptor_data_get (descriptor);
3369	}
3370
3371
3372	/* Return an expression for the base offset of an array. */
3373
3374	tree
3375	gfc_conv_array_offset (tree descriptor)
3376	{
3377	tree type;
3378
3379	type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3379, __FUNCTION__))->typed.type);
3380	if (GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3380, __FUNCTION__))->type_common.lang_flag_2))
3381	return GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3381, __FUNCTION__))->type_with_lang_specific.lang_specific )->offset);
3382	else
3383	return gfc_conv_descriptor_offset_get (descriptor);
3384	}
3385
3386
3387	/* Get an expression for the array stride. */
3388
3389	tree
3390	gfc_conv_array_stride (tree descriptor, int dim)
3391	{
3392	tree tmp;
3393	tree type;
3394
3395	type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3395, __FUNCTION__))->typed.type);
3396
3397	/* For descriptorless arrays use the array size. */
3398	tmp = GFC_TYPE_ARRAY_STRIDE (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3398, __FUNCTION__))->type_with_lang_specific.lang_specific )->stride[dim]);
3399	if (tmp != NULL_TREE(tree) __null)
3400	return tmp;
3401
3402	tmp = gfc_conv_descriptor_stride_get (descriptor, gfc_rank_cst[dim]);
3403	return tmp;
3404	}
3405
3406
3407	/* Like gfc_conv_array_stride, but for the lower bound. */
3408
3409	tree
3410	gfc_conv_array_lbound (tree descriptor, int dim)
3411	{
3412	tree tmp;
3413	tree type;
3414
3415	type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3415, __FUNCTION__))->typed.type);
3416
3417	tmp = GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3417, __FUNCTION__))->type_with_lang_specific.lang_specific )->lbound[dim]);
3418	if (tmp != NULL_TREE(tree) __null)
3419	return tmp;
3420
3421	tmp = gfc_conv_descriptor_lbound_get (descriptor, gfc_rank_cst[dim]);
3422	return tmp;
3423	}
3424
3425
3426	/* Like gfc_conv_array_stride, but for the upper bound. */
3427
3428	tree
3429	gfc_conv_array_ubound (tree descriptor, int dim)
3430	{
3431	tree tmp;
3432	tree type;
3433
3434	type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3434, __FUNCTION__))->typed.type);
3435
3436	tmp = GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3436, __FUNCTION__))->type_with_lang_specific.lang_specific )->ubound[dim]);
3437	if (tmp != NULL_TREE(tree) __null)
3438	return tmp;
3439
3440	/* This should only ever happen when passing an assumed shape array
3441	as an actual parameter. The value will never be used. */
3442	if (GFC_ARRAY_TYPE_P (TREE_TYPE (descriptor))((tree_class_check ((((contains_struct_check ((descriptor), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3442, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3442, __FUNCTION__))->type_common.lang_flag_2))
3443	return gfc_index_zero_nodegfc_rank_cst[0];
3444
3445	tmp = gfc_conv_descriptor_ubound_get (descriptor, gfc_rank_cst[dim]);
3446	return tmp;
3447	}
3448
3449
3450	/* Generate code to perform an array index bound check. */
3451
3452	static tree
3453	trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
3454	locus * where, bool check_upper)
3455	{
3456	tree fault;
3457	tree tmp_lo, tmp_up;
3458	tree descriptor;
3459	char *msg;
3460	const char * name = NULL__null;
3461
3462	if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0)))
3463	return index;
3464
3465	descriptor = ss->info->data.array.descriptor;
3466
3467	index = gfc_evaluate_now (index, &se->pre);
3468
3469	/* We find a name for the error message. */
3470	name = ss->info->expr->symtree->n.sym->name;
3471	gcc_assert (name != NULL)((void)(!(name != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3471, __FUNCTION__), 0 : 0));
3472
3473	if (VAR_P (descriptor)(((enum tree_code) (descriptor)->base.code) == VAR_DECL))
3474	name = IDENTIFIER_POINTER (DECL_NAME (descriptor))((const char *) (tree_check ((((contains_struct_check ((descriptor ), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3474, __FUNCTION__))->decl_minimal.name)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3474, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str );
3475
3476	/* If upper bound is present, include both bounds in the error message. */
3477	if (check_upper)
3478	{
3479	tmp_lo = gfc_conv_array_lbound (descriptor, n);
3480	tmp_up = gfc_conv_array_ubound (descriptor, n);
3481
3482	if (name)
3483	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
3484	"outside of expected range (%%ld:%%ld)", n+1, name);
3485	else
3486	msg = xasprintf ("Index '%%ld' of dimension %d "
3487	"outside of expected range (%%ld:%%ld)", n+1);
3488
3489	fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
3490	index, tmp_lo);
3491	gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
3492	fold_convert (long_integer_type_node, index)fold_convert_loc (((location_t) 0), integer_types[itk_long], index ),
3493	fold_convert (long_integer_type_node, tmp_lo)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_lo ),
3494	fold_convert (long_integer_type_node, tmp_up)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_up ));
3495	fault = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
3496	index, tmp_up);
3497	gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
3498	fold_convert (long_integer_type_node, index)fold_convert_loc (((location_t) 0), integer_types[itk_long], index ),
3499	fold_convert (long_integer_type_node, tmp_lo)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_lo ),
3500	fold_convert (long_integer_type_node, tmp_up)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_up ));
3501	free (msg);
3502	}
3503	else
3504	{
3505	tmp_lo = gfc_conv_array_lbound (descriptor, n);
3506
3507	if (name)
3508	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
3509	"below lower bound of %%ld", n+1, name);
3510	else
3511	msg = xasprintf ("Index '%%ld' of dimension %d "
3512	"below lower bound of %%ld", n+1);
3513
3514	fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
3515	index, tmp_lo);
3516	gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
3517	fold_convert (long_integer_type_node, index)fold_convert_loc (((location_t) 0), integer_types[itk_long], index ),
3518	fold_convert (long_integer_type_node, tmp_lo)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_lo ));
3519	free (msg);
3520	}
3521
3522	return index;
3523	}
3524
3525
3526	/* Return the offset for an index. Performs bound checking for elemental
3527	dimensions. Single element references are processed separately.
3528	DIM is the array dimension, I is the loop dimension. */
3529
3530	static tree
3531	conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
3532	gfc_array_ref * ar, tree stride)
3533	{
3534	gfc_array_info *info;
3535	tree index;
3536	tree desc;
3537	tree data;
3538
3539	info = &ss->info->data.array;
3540
3541	/* Get the index into the array for this dimension. */
3542	if (ar)
3543	{
3544	gcc_assert (ar->type != AR_ELEMENT)((void)(!(ar->type != AR_ELEMENT) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3544, __FUNCTION__), 0 : 0));
3545	switch (ar->dimen_type[dim])
3546	{
3547	case DIMEN_THIS_IMAGE:
3548	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3548, __FUNCTION__));
3549	break;
3550	case DIMEN_ELEMENT:
3551	/* Elemental dimension. */
3552	gcc_assert (info->subscript[dim]((void)(!(info->subscript[dim] && info->subscript [dim]->info->type == GFC_SS_SCALAR) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3553, __FUNCTION__), 0 : 0))
3553	&& info->subscript[dim]->info->type == GFC_SS_SCALAR)((void)(!(info->subscript[dim] && info->subscript [dim]->info->type == GFC_SS_SCALAR) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3553, __FUNCTION__), 0 : 0));
3554	/* We've already translated this value outside the loop. */
3555	index = info->subscript[dim]->info->data.scalar.value;
3556
3557	index = trans_array_bound_check (se, ss, index, dim, &ar->where,
3558	ar->as->type != AS_ASSUMED_SIZE
3559	\|\| dim < ar->dimen - 1);
3560	break;
3561
3562	case DIMEN_VECTOR:
3563	gcc_assert (info && se->loop)((void)(!(info && se->loop) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3563, __FUNCTION__), 0 : 0));
3564	gcc_assert (info->subscript[dim]((void)(!(info->subscript[dim] && info->subscript [dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3565, __FUNCTION__), 0 : 0))
3565	&& info->subscript[dim]->info->type == GFC_SS_VECTOR)((void)(!(info->subscript[dim] && info->subscript [dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3565, __FUNCTION__), 0 : 0));
3566	desc = info->subscript[dim]->info->data.array.descriptor;
3567
3568	/* Get a zero-based index into the vector. */
3569	index = fold_build2_loc (input_location, MINUS_EXPR,
3570	gfc_array_index_type,
3571	se->loop->loopvar[i], se->loop->from[i]);
3572
3573	/* Multiply the index by the stride. */
3574	index = fold_build2_loc (input_location, MULT_EXPR,
3575	gfc_array_index_type,
3576	index, gfc_conv_array_stride (desc, 0));
3577
3578	/* Read the vector to get an index into info->descriptor. */
3579	data = build_fold_indirect_ref_loc (input_location,
3580	gfc_conv_array_data (desc));
3581	index = gfc_build_array_ref (data, index, NULL__null);
3582	index = gfc_evaluate_now (index, &se->pre);
3583	index = fold_convert (gfc_array_index_type, index)fold_convert_loc (((location_t) 0), gfc_array_index_type, index );
3584
3585	/* Do any bounds checking on the final info->descriptor index. */
3586	index = trans_array_bound_check (se, ss, index, dim, &ar->where,
3587	ar->as->type != AS_ASSUMED_SIZE
3588	\|\| dim < ar->dimen - 1);
3589	break;
3590
3591	case DIMEN_RANGE:
3592	/* Scalarized dimension. */
3593	gcc_assert (info && se->loop)((void)(!(info && se->loop) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3593, __FUNCTION__), 0 : 0));
3594
3595	/* Multiply the loop variable by the stride and delta. */
3596	index = se->loop->loopvar[i];
3597	if (!integer_onep (info->stride[dim]))
3598	index = fold_build2_loc (input_location, MULT_EXPR,
3599	gfc_array_index_type, index,
3600	info->stride[dim]);
3601	if (!integer_zerop (info->delta[dim]))
3602	index = fold_build2_loc (input_location, PLUS_EXPR,
3603	gfc_array_index_type, index,
3604	info->delta[dim]);
3605	break;
3606
3607	default:
3608	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3608, __FUNCTION__));
3609	}
3610	}
3611	else
3612	{
3613	/* Temporary array or derived type component. */
3614	gcc_assert (se->loop)((void)(!(se->loop) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3614, __FUNCTION__), 0 : 0));
3615	index = se->loop->loopvar[se->loop->order[i]];
3616
3617	/* Pointer functions can have stride[0] different from unity.
3618	Use the stride returned by the function call and stored in
3619	the descriptor for the temporary. */
3620	if (se->ss && se->ss->info->type == GFC_SS_FUNCTION
3621	&& se->ss->info->expr
3622	&& se->ss->info->expr->symtree
3623	&& se->ss->info->expr->symtree->n.sym->result
3624	&& se->ss->info->expr->symtree->n.sym->result->attr.pointer)
3625	stride = gfc_conv_descriptor_stride_get (info->descriptor,
3626	gfc_rank_cst[dim]);
3627
3628	if (info->delta[dim] && !integer_zerop (info->delta[dim]))
3629	index = fold_build2_loc (input_location, PLUS_EXPR,
3630	gfc_array_index_type, index, info->delta[dim]);
3631	}
3632
3633	/* Multiply by the stride. */
3634	if (stride != NULL__null && !integer_onep (stride))
3635	index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
3636	index, stride);
3637
3638	return index;
3639	}
3640
3641
3642	/* Build a scalarized array reference using the vptr 'size'. */
3643
3644	static bool
3645	build_class_array_ref (gfc_se *se, tree base, tree index)
3646	{
3647	tree size;
3648	tree decl = NULL_TREE(tree) __null;
3649	tree tmp;
3650	gfc_expr *expr = se->ss->info->expr;
3651	gfc_expr *class_expr;
3652	gfc_typespec *ts;
3653	gfc_symbol *sym;
3654
3655	tmp = !VAR_P (base)(((enum tree_code) (base)->base.code) == VAR_DECL) ? gfc_get_class_from_expr (base) : NULL_TREE(tree) __null;
3656
3657	if (tmp != NULL_TREE(tree) __null)
3658	decl = tmp;
3659	else
3660	{
3661	/* The base expression does not contain a class component, either
3662	because it is a temporary array or array descriptor. Class
3663	array functions are correctly resolved above. */
3664	if (!expr
3665	\|\| (expr->ts.type != BT_CLASS
3666	&& !gfc_is_class_array_ref (expr, NULL__null)))
3667	return false;
3668
3669	/* Obtain the expression for the class entity or component that is
3670	followed by an array reference, which is not an element, so that
3671	the span of the array can be obtained. */
3672	class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts);
3673
3674	if (!ts)
3675	return false;
3676
3677	sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL__null;
3678	if (sym && sym->attr.function
3679	&& sym == sym->result
3680	&& sym->backend_decl == current_function_decl)
3681	/* The temporary is the data field of the class data component
3682	of the current function. */
3683	decl = gfc_get_fake_result_decl (sym, 0);
3684	else if (sym)
3685	{
3686	if (decl == NULL_TREE(tree) __null)
3687	decl = expr->symtree->n.sym->backend_decl;
3688	/* For class arrays the tree containing the class is stored in
3689	GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
3690	For all others it's sym's backend_decl directly. */
3691	if (DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3691, __FUNCTION__))->decl_common.lang_specific) && GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3691, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
3692	decl = GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3692, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
3693	}
3694	else
3695	decl = gfc_get_class_from_gfc_expr (class_expr);
3696
3697	if (POINTER_TYPE_P (TREE_TYPE (decl))(((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3697, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3697, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
3698	decl = build_fold_indirect_ref_loc (input_location, decl);
3699
3700	if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl))((tree_class_check ((((contains_struct_check ((decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3700, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3700, __FUNCTION__))->type_common.lang_flag_4))
3701	return false;
3702	}
3703
3704	se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
3705
3706	size = gfc_class_vtab_size_get (decl);
3707	/* For unlimited polymorphic entities then _len component needs to be
3708	multiplied with the size. */
3709	size = gfc_resize_class_size_with_len (&se->pre, decl, size);
3710	size = fold_convert (TREE_TYPE (index), size)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (index), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3710, __FUNCTION__))->typed.type), size);
3711
3712	/* Return the element in the se expression. */
3713	se->expr = gfc_build_spanned_array_ref (base, index, size);
3714	return true;
3715	}
3716
3717
3718	/* Indicates that the tree EXPR is a reference to an array that can’t
3719	have any negative stride. */
3720
3721	static bool
3722	non_negative_strides_array_p (tree expr)
3723	{
3724	if (expr == NULL_TREE(tree) __null)
3725	return false;
3726
3727	tree type = TREE_TYPE (expr)((contains_struct_check ((expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3727, __FUNCTION__))->typed.type);
3728	if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE \|\| ( (enum tree_code) (type)->base.code) == REFERENCE_TYPE))
3729	type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3729, __FUNCTION__))->typed.type);
3730
3731	if (TYPE_LANG_SPECIFIC (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3731, __FUNCTION__))->type_with_lang_specific.lang_specific ))
3732	{
3733	gfc_array_kind array_kind = GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3733, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind);
3734
3735	if (array_kind == GFC_ARRAY_ALLOCATABLE
3736	\|\| array_kind == GFC_ARRAY_ASSUMED_SHAPE_CONT)
3737	return true;
3738	}
3739
3740	/* An array with descriptor can have negative strides.
3741	We try to be conservative and return false by default here
3742	if we don’t recognize a contiguous array instead of
3743	returning false if we can identify a non-contiguous one. */
3744	if (!GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3744, __FUNCTION__))->type_common.lang_flag_2))
3745	return false;
3746
3747	/* If the array was originally a dummy with a descriptor, strides can be
3748	negative. */
3749	if (DECL_P (expr)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (expr)->base.code))] == tcc_declaration)
3750	&& DECL_LANG_SPECIFIC (expr)((contains_struct_check ((expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3750, __FUNCTION__))->decl_common.lang_specific)
3751	&& GFC_DECL_SAVED_DESCRIPTOR (expr)(((contains_struct_check ((expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3751, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor )
3752	&& GFC_DECL_SAVED_DESCRIPTOR (expr)(((contains_struct_check ((expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3752, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ) != expr)
3753	return non_negative_strides_array_p (GFC_DECL_SAVED_DESCRIPTOR (expr)(((contains_struct_check ((expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3753, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ));
3754
3755	return true;
3756	}
3757
3758
3759	/* Build a scalarized reference to an array. */
3760
3761	static void
3762	gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar,
3763	bool tmp_array = false)
3764	{
3765	gfc_array_info *info;
3766	tree decl = NULL_TREE(tree) __null;
3767	tree index;
3768	tree base;
3769	gfc_ss *ss;
3770	gfc_expr *expr;
3771	int n;
3772
3773	ss = se->ss;
3774	expr = ss->info->expr;
3775	info = &ss->info->data.array;
3776	if (ar)
3777	n = se->loop->order[0];
3778	else
3779	n = 0;
3780
3781	index = conv_array_index_offset (se, ss, ss->dim[n], n, ar, info->stride0);
3782	/* Add the offset for this dimension to the stored offset for all other
3783	dimensions. */
3784	if (info->offset && !integer_zerop (info->offset))
3785	index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
3786	index, info->offset);
3787
3788	base = build_fold_indirect_ref_loc (input_location, info->data);
3789
3790	/* Use the vptr 'size' field to access the element of a class array. */
3791	if (build_class_array_ref (se, base, index))
3792	return;
3793
3794	if (get_CFI_desc (NULL__null, expr, &decl, ar))
3795	decl = build_fold_indirect_ref_loc (input_location, decl);
3796
3797	/* A pointer array component can be detected from its field decl. Fix
3798	the descriptor, mark the resulting variable decl and pass it to
3799	gfc_build_array_ref. */
3800	if (is_pointer_array (info->descriptor)
3801	\|\| (expr && expr->ts.deferred && info->descriptor
3802	&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))((tree_class_check ((((contains_struct_check ((info->descriptor ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3802, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3802, __FUNCTION__))->type_common.lang_flag_1)))
3803	{
3804	if (TREE_CODE (info->descriptor)((enum tree_code) (info->descriptor)->base.code) == COMPONENT_REF)
3805	decl = info->descriptor;
3806	else if (TREE_CODE (info->descriptor)((enum tree_code) (info->descriptor)->base.code) == INDIRECT_REF)
3807	decl = TREE_OPERAND (info->descriptor, 0)(((const_cast<tree> (tree_operand_check ((info->descriptor ), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3807, __FUNCTION__)))));
3808
3809	if (decl == NULL_TREE(tree) __null)
3810	decl = info->descriptor;
3811	}
3812
3813	bool non_negative_stride = tmp_array
3814	\|\| non_negative_strides_array_p (info->descriptor);
3815	se->expr = gfc_build_array_ref (base, index, decl,
3816	non_negative_stride);
3817	}
3818
3819
3820	/* Translate access of temporary array. */
3821
3822	void
3823	gfc_conv_tmp_array_ref (gfc_se * se)
3824	{
3825	se->string_length = se->ss->info->string_length;
3826	gfc_conv_scalarized_array_ref (se, NULL__null, true);
3827	gfc_advance_se_ss_chain (se);
3828	}
3829
3830	/* Add T to the offset pair OFFSET, CST_OFFSET. */
3831
3832	static void
3833	add_to_offset (tree cst_offset, tree offset, tree t)
3834	{
3835	if (TREE_CODE (t)((enum tree_code) (t)->base.code) == INTEGER_CST)
3836	cst_offset = int_const_binop (PLUS_EXPR, cst_offset, t);
3837	else
3838	{
3839	if (!integer_zerop (*offset))
3840	*offset = fold_build2_loc (input_location, PLUS_EXPR,
3841	gfc_array_index_type, *offset, t);
3842	else
3843	*offset = t;
3844	}
3845	}
3846
3847
3848	static tree
3849	build_array_ref (tree desc, tree offset, tree decl, tree vptr)
3850	{
3851	tree tmp;
3852	tree type;
3853	tree cdesc;
3854
3855	/* For class arrays the class declaration is stored in the saved
3856	descriptor. */
3857	if (INDIRECT_REF_P (desc)(((enum tree_code) (desc)->base.code) == INDIRECT_REF)
3858	&& DECL_LANG_SPECIFIC (TREE_OPERAND (desc, 0))((contains_struct_check (((((const_cast<tree> (tree_operand_check ((desc), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3858, __FUNCTION__)))))), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3858, __FUNCTION__))->decl_common.lang_specific)
3859	&& GFC_DECL_SAVED_DESCRIPTOR (TREE_OPERAND (desc, 0))(((contains_struct_check (((((const_cast<tree> (tree_operand_check ((desc), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3859, __FUNCTION__)))))), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3859, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
3860	cdesc = gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR ((((contains_struct_check (((((const_cast<tree> (tree_operand_check ((desc), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3861, __FUNCTION__)))))), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3861, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor )
3861	TREE_OPERAND (desc, 0))(((contains_struct_check (((((const_cast<tree> (tree_operand_check ((desc), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3861, __FUNCTION__)))))), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3861, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ));
3862	else
3863	cdesc = desc;
3864
3865	/* Class container types do not always have the GFC_CLASS_TYPE_P
3866	but the canonical type does. */
3867	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (cdesc))((tree_class_check ((((contains_struct_check ((cdesc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3867, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3867, __FUNCTION__))->type_common.lang_flag_1)
3868	&& TREE_CODE (cdesc)((enum tree_code) (cdesc)->base.code) == COMPONENT_REF)
3869	{
3870	type = TREE_TYPE (TREE_OPERAND (cdesc, 0))((contains_struct_check (((((const_cast<tree> (tree_operand_check ((cdesc), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3870, __FUNCTION__)))))), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3870, __FUNCTION__))->typed.type);
3871	if (TYPE_CANONICAL (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3871, __FUNCTION__))->type_common.canonical)
3872	&& GFC_CLASS_TYPE_P (TYPE_CANONICAL (type))((tree_class_check ((((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3872, __FUNCTION__))->type_common.canonical)), (tcc_type ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3872, __FUNCTION__))->type_common.lang_flag_4))
3873	vptr = gfc_class_vptr_get (TREE_OPERAND (cdesc, 0)(((const_cast<tree> (tree_operand_check ((cdesc), (0) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3873, __FUNCTION__))))));
3874	}
3875
3876	tmp = gfc_conv_array_data (desc);
3877	tmp = build_fold_indirect_ref_loc (input_location, tmp);
3878	tmp = gfc_build_array_ref (tmp, offset, decl,
3879	non_negative_strides_array_p (desc),
3880	vptr);
3881	return tmp;
3882	}
3883
3884
3885	/* Build an array reference. se->expr already holds the array descriptor.
3886	This should be either a variable, indirect variable reference or component
3887	reference. For arrays which do not have a descriptor, se->expr will be
3888	the data pointer.
3889	a(i, j, k) = base[offset + i * stride[0] + j * stride[1] + k * stride[2]]*/
3890
3891	void
3892	gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
3893	locus * where)
3894	{
3895	int n;
3896	tree offset, cst_offset;
3897	tree tmp;
3898	tree stride;
3899	tree decl = NULL_TREE(tree) __null;
3900	gfc_se indexse;
3901	gfc_se tmpse;
3902	gfc_symbol * sym = expr->symtree->n.sym;
3903	char *var_name = NULL__null;
3904
3905	if (ar->dimen == 0)
3906	{
3907	gcc_assert (ar->codimen \|\| sym->attr.select_rank_temporary((void)(!(ar->codimen \|\| sym->attr.select_rank_temporary \|\| (ar->as && ar->as->corank)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3908, __FUNCTION__), 0 : 0))
3908	\|\| (ar->as && ar->as->corank))((void)(!(ar->codimen \|\| sym->attr.select_rank_temporary \|\| (ar->as && ar->as->corank)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3908, __FUNCTION__), 0 : 0));
3909
3910	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3910, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3910, __FUNCTION__))->type_common.lang_flag_1))
3911	se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr))build_fold_indirect_ref_loc (((location_t) 0), gfc_conv_array_data (se->expr));
3912	else
3913	{
3914	if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3914, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3914, __FUNCTION__))->type_common.lang_flag_2)
3915	&& TREE_CODE (TREE_TYPE (se->expr))((enum tree_code) (((contains_struct_check ((se->expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3915, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE)
3916	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
3917
3918	/* Use the actual tree type and not the wrapped coarray. */
3919	if (!se->want_pointer)
3920	se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)),fold_convert_loc (((location_t) 0), ((tree_class_check ((((contains_struct_check ((se->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3920, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3920, __FUNCTION__))->type_common.main_variant), se-> expr)
3921	se->expr)fold_convert_loc (((location_t) 0), ((tree_class_check ((((contains_struct_check ((se->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3920, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 3920, __FUNCTION__))->type_common.main_variant), se-> expr);
3922	}
3923
3924	return;
3925	}
3926
3927	/* Handle scalarized references separately. */
3928	if (ar->type != AR_ELEMENT)
3929	{
3930	gfc_conv_scalarized_array_ref (se, ar);
3931	gfc_advance_se_ss_chain (se);
3932	return;
3933	}
3934
3935	if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
3936	{
3937	size_t len;
3938	gfc_ref *ref;
3939
3940	len = strlen (sym->name) + 1;
3941	for (ref = expr->ref; ref; ref = ref->next)
3942	{
3943	if (ref->type == REF_ARRAY && &ref->u.ar == ar)
3944	break;
3945	if (ref->type == REF_COMPONENT)
3946	len += 2 + strlen (ref->u.c.component->name);
3947	}
3948
3949	var_name = XALLOCAVEC (char, len)((char ) __builtin_alloca(sizeof (char) (len)));
3950	strcpy (var_name, sym->name);
3951
3952	for (ref = expr->ref; ref; ref = ref->next)
3953	{
3954	if (ref->type == REF_ARRAY && &ref->u.ar == ar)
3955	break;
3956	if (ref->type == REF_COMPONENT)
3957	{
3958	strcat (var_name, "%%");
3959	strcat (var_name, ref->u.c.component->name);
3960	}
3961	}
3962	}
3963
3964	decl = se->expr;
3965	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) && sym->attr.dummy && ar->as->type != AS_DEFERRED)
3966	decl = sym->backend_decl;
3967
3968	cst_offset = offset = gfc_index_zero_nodegfc_rank_cst[0];
3969	add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (decl));
3970
3971	/* Calculate the offsets from all the dimensions. Make sure to associate
3972	the final offset so that we form a chain of loop invariant summands. */
3973	for (n = ar->dimen - 1; n >= 0; n--)
3974	{
3975	/* Calculate the index for this dimension. */
3976	gfc_init_se (&indexse, se);
3977	gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
3978	gfc_add_block_to_block (&se->pre, &indexse.pre);
3979
3980	if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0)) && ! expr->no_bounds_check)
3981	{
3982	/* Check array bounds. */
3983	tree cond;
3984	char *msg;
3985
3986	/* Evaluate the indexse.expr only once. */
3987	indexse.expr = save_expr (indexse.expr);
3988
3989	/* Lower bound. */
3990	tmp = gfc_conv_array_lbound (decl, n);
3991	if (sym->attr.temporary)
3992	{
3993	gfc_init_se (&tmpse, se);
3994	gfc_conv_expr_type (&tmpse, ar->as->lower[n],
3995	gfc_array_index_type);
3996	gfc_add_block_to_block (&se->pre, &tmpse.pre);
3997	tmp = tmpse.expr;
3998	}
3999
4000	cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
4001	indexse.expr, tmp);
4002	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4003	"below lower bound of %%ld", n+1, var_name);
4004	gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
4005	fold_convert (long_integer_type_node,fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse .expr)
4006	indexse.expr)fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse .expr),
4007	fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp ));
4008	free (msg);
4009
4010	/* Upper bound, but not for the last dimension of assumed-size
4011	arrays. */
4012	if (n < ar->dimen - 1 \|\| ar->as->type != AS_ASSUMED_SIZE)
4013	{
4014	tmp = gfc_conv_array_ubound (decl, n);
4015	if (sym->attr.temporary)
4016	{
4017	gfc_init_se (&tmpse, se);
4018	gfc_conv_expr_type (&tmpse, ar->as->upper[n],
4019	gfc_array_index_type);
4020	gfc_add_block_to_block (&se->pre, &tmpse.pre);
4021	tmp = tmpse.expr;
4022	}
4023
4024	cond = fold_build2_loc (input_location, GT_EXPR,
4025	logical_type_node, indexse.expr, tmp);
4026	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4027	"above upper bound of %%ld", n+1, var_name);
4028	gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
4029	fold_convert (long_integer_type_node,fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse .expr)
4030	indexse.expr)fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse .expr),
4031	fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp ));
4032	free (msg);
4033	}
4034	}
4035
4036	/* Multiply the index by the stride. */
4037	stride = gfc_conv_array_stride (decl, n);
4038	tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
4039	indexse.expr, stride);
4040
4041	/* And add it to the total. */
4042	add_to_offset (&cst_offset, &offset, tmp);
4043	}
4044
4045	if (!integer_zerop (cst_offset))
4046	offset = fold_build2_loc (input_location, PLUS_EXPR,
4047	gfc_array_index_type, offset, cst_offset);
4048
4049	/* A pointer array component can be detected from its field decl. Fix
4050	the descriptor, mark the resulting variable decl and pass it to
4051	build_array_ref. */
4052	decl = NULL_TREE(tree) __null;
4053	if (get_CFI_desc (sym, expr, &decl, ar))
4054	decl = build_fold_indirect_ref_loc (input_location, decl);
4055	if (!expr->ts.deferred && !sym->attr.codimension
4056	&& is_pointer_array (se->expr))
4057	{
4058	if (TREE_CODE (se->expr)((enum tree_code) (se->expr)->base.code) == COMPONENT_REF)
4059	decl = se->expr;
4060	else if (TREE_CODE (se->expr)((enum tree_code) (se->expr)->base.code) == INDIRECT_REF)
4061	decl = TREE_OPERAND (se->expr, 0)(((const_cast<tree> (tree_operand_check ((se->expr ), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4061, __FUNCTION__)))));
4062	else
4063	decl = se->expr;
4064	}
4065	else if (expr->ts.deferred
4066	\|\| (sym->ts.type == BT_CHARACTER
4067	&& sym->attr.select_type_temporary))
4068	{
4069	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4069, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4069, __FUNCTION__))->type_common.lang_flag_1))
4070	{
4071	decl = se->expr;
4072	if (TREE_CODE (decl)((enum tree_code) (decl)->base.code) == INDIRECT_REF)
4073	decl = TREE_OPERAND (decl, 0)(((const_cast<tree> (tree_operand_check ((decl), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4073, __FUNCTION__)))));
4074	}
4075	else
4076	decl = sym->backend_decl;
4077	}
4078	else if (sym->ts.type == BT_CLASS)
4079	{
4080	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 ))
4081	{
4082	gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (expr);
4083	gfc_init_se (&tmpse, NULL__null);
4084	gfc_conv_expr (&tmpse, class_expr);
4085	if (!se->class_vptr)
4086	se->class_vptr = gfc_class_vptr_get (tmpse.expr);
4087	gfc_free_expr (class_expr);
4088	decl = tmpse.expr;
4089	}
4090	else
4091	decl = NULL_TREE(tree) __null;
4092	}
4093
4094	se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
4095	}
4096
4097
4098	/* Add the offset corresponding to array's ARRAY_DIM dimension and loop's
4099	LOOP_DIM dimension (if any) to array's offset. */
4100
4101	static void
4102	add_array_offset (stmtblock_t pblock, gfc_loopinfo loop, gfc_ss *ss,
4103	gfc_array_ref *ar, int array_dim, int loop_dim)
4104	{
4105	gfc_se se;
4106	gfc_array_info *info;
4107	tree stride, index;
4108
4109	info = &ss->info->data.array;
4110
4111	gfc_init_se (&se, NULL__null);
4112	se.loop = loop;
4113	se.expr = info->descriptor;
4114	stride = gfc_conv_array_stride (info->descriptor, array_dim);
4115	index = conv_array_index_offset (&se, ss, array_dim, loop_dim, ar, stride);
4116	gfc_add_block_to_block (pblock, &se.pre);
4117
4118	info->offset = fold_build2_loc (input_location, PLUS_EXPR,
4119	gfc_array_index_type,
4120	info->offset, index);
4121	info->offset = gfc_evaluate_now (info->offset, pblock);
4122	}
4123
4124
4125	/* Generate the code to be executed immediately before entering a
4126	scalarization loop. */
4127
4128	static void
4129	gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
4130	stmtblock_t * pblock)
4131	{
4132	tree stride;
4133	gfc_ss_info *ss_info;
4134	gfc_array_info *info;
4135	gfc_ss_type ss_type;
4136	gfc_ss ss, pss;
4137	gfc_loopinfo *ploop;
4138	gfc_array_ref *ar;
4139	int i;
4140
4141	/* This code will be executed before entering the scalarization loop
4142	for this dimension. */
4143	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4144	{
4145	ss_info = ss->info;
4146
4147	if ((ss_info->useflags & flag) == 0)
4148	continue;
4149
4150	ss_type = ss_info->type;
4151	if (ss_type != GFC_SS_SECTION
4152	&& ss_type != GFC_SS_FUNCTION
4153	&& ss_type != GFC_SS_CONSTRUCTOR
4154	&& ss_type != GFC_SS_COMPONENT)
4155	continue;
4156
4157	info = &ss_info->data.array;
4158
4159	gcc_assert (dim < ss->dimen)((void)(!(dim < ss->dimen) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4159, __FUNCTION__), 0 : 0));
4160	gcc_assert (ss->dimen == loop->dimen)((void)(!(ss->dimen == loop->dimen) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4160, __FUNCTION__), 0 : 0));
4161
4162	if (info->ref)
4163	ar = &info->ref->u.ar;
4164	else
4165	ar = NULL__null;
4166
4167	if (dim == loop->dimen - 1 && loop->parent != NULL__null)
4168	{
4169	/* If we are in the outermost dimension of this loop, the previous
4170	dimension shall be in the parent loop. */
4171	gcc_assert (ss->parent != NULL)((void)(!(ss->parent != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4171, __FUNCTION__), 0 : 0));
4172
4173	pss = ss->parent;
4174	ploop = loop->parent;
4175
4176	/* ss and ss->parent are about the same array. */
4177	gcc_assert (ss_info == pss->info)((void)(!(ss_info == pss->info) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4177, __FUNCTION__), 0 : 0));
4178	}
4179	else
4180	{
4181	ploop = loop;
4182	pss = ss;
4183	}
4184
4185	if (dim == loop->dimen - 1)
4186	i = 0;
4187	else
4188	i = dim + 1;
4189
4190	/* For the time being, there is no loop reordering. */
4191	gcc_assert (i == ploop->order[i])((void)(!(i == ploop->order[i]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4191, __FUNCTION__), 0 : 0));
4192	i = ploop->order[i];
4193
4194	if (dim == loop->dimen - 1 && loop->parent == NULL__null)
4195	{
4196	stride = gfc_conv_array_stride (info->descriptor,
4197	innermost_ss (ss)->dim[i]);
4198
4199	/* Calculate the stride of the innermost loop. Hopefully this will
4200	allow the backend optimizers to do their stuff more effectively.
4201	*/
4202	info->stride0 = gfc_evaluate_now (stride, pblock);
4203
4204	/* For the outermost loop calculate the offset due to any
4205	elemental dimensions. It will have been initialized with the
4206	base offset of the array. */
4207	if (info->ref)
4208	{
4209	for (i = 0; i < ar->dimen; i++)
4210	{
4211	if (ar->dimen_type[i] != DIMEN_ELEMENT)
4212	continue;
4213
4214	add_array_offset (pblock, loop, ss, ar, i, /* unused */ -1);
4215	}
4216	}
4217	}
4218	else
4219	/* Add the offset for the previous loop dimension. */
4220	add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
4221
4222	/* Remember this offset for the second loop. */
4223	if (dim == loop->temp_dim - 1 && loop->parent == NULL__null)
4224	info->saved_offset = info->offset;
4225	}
4226	}
4227
4228
4229	/* Start a scalarized expression. Creates a scope and declares loop
4230	variables. */
4231
4232	void
4233	gfc_start_scalarized_body (gfc_loopinfo * loop, stmtblock_t * pbody)
4234	{
4235	int dim;
4236	int n;
4237	int flags;
4238
4239	gcc_assert (!loop->array_parameter)((void)(!(!loop->array_parameter) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4239, __FUNCTION__), 0 : 0));
4240
4241	for (dim = loop->dimen - 1; dim >= 0; dim--)
4242	{
4243	n = loop->order[dim];
4244
4245	gfc_start_block (&loop->code[n]);
4246
4247	/* Create the loop variable. */
4248	loop->loopvar[n] = gfc_create_var (gfc_array_index_type, "S");
4249
4250	if (dim < loop->temp_dim)
4251	flags = 3;
4252	else
4253	flags = 1;
4254	/* Calculate values that will be constant within this loop. */
4255	gfc_trans_preloop_setup (loop, dim, flags, &loop->code[n]);
4256	}
4257	gfc_start_block (pbody);
4258	}
4259
4260
4261	/* Generates the actual loop code for a scalarization loop. */
4262
4263	static void
4264	gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
4265	stmtblock_t * pbody)
4266	{
4267	stmtblock_t block;
4268	tree cond;
4269	tree tmp;
4270	tree loopbody;
4271	tree exit_label;
4272	tree stmt;
4273	tree init;
4274	tree incr;
4275
4276	if ((ompws_flags & (OMPWS_WORKSHARE_FLAG1 \| OMPWS_SCALARIZER_WS4
4277	\| OMPWS_SCALARIZER_BODY8))
4278	== (OMPWS_WORKSHARE_FLAG1 \| OMPWS_SCALARIZER_WS4)
4279	&& n == loop->dimen - 1)
4280	{
4281	/* We create an OMP_FOR construct for the outermost scalarized loop. */
4282	init = make_tree_vec (1);
4283	cond = make_tree_vec (1);
4284	incr = make_tree_vec (1);
4285
4286	/* Cycle statement is implemented with a goto. Exit statement must not
4287	be present for this loop. */
4288	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
4289	TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
4290
4291	/* Label for cycle statements (if needed). */
4292	tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
4293	gfc_add_expr_to_block (pbody, tmp);
4294
4295	stmt = make_node (OMP_FOR);
4296
4297	TREE_TYPE (stmt)((contains_struct_check ((stmt), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4297, __FUNCTION__))->typed.type) = void_type_nodeglobal_trees[TI_VOID_TYPE];
4298	OMP_FOR_BODY (stmt)(((const_cast<tree> (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR), (OACC_LOOP), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4298, __FUNCTION__))), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4298, __FUNCTION__))))) = loopbody = gfc_finish_block (pbody);
4299
4300	OMP_FOR_CLAUSES (stmt)(((const_cast<tree> (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR), (OACC_LOOP), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4300, __FUNCTION__))), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4300, __FUNCTION__))))) = build_omp_clause (input_location,
4301	OMP_CLAUSE_SCHEDULE);
4302	OMP_CLAUSE_SCHEDULE_KIND (OMP_FOR_CLAUSES (stmt))((omp_clause_subcode_check (((((const_cast<tree> (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR), (OACC_LOOP), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4302, __FUNCTION__))), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4302, __FUNCTION__)))))), (OMP_CLAUSE_SCHEDULE), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4302, __FUNCTION__))->omp_clause.subcode.schedule_kind)
4303	= OMP_CLAUSE_SCHEDULE_STATIC;
4304	if (ompws_flags & OMPWS_NOWAIT16)
4305	OMP_CLAUSE_CHAIN (OMP_FOR_CLAUSES (stmt))((contains_struct_check (((tree_check (((((const_cast<tree > (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR ), (OACC_LOOP), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4305, __FUNCTION__))), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4305, __FUNCTION__)))))), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4305, __FUNCTION__, (OMP_CLAUSE)))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4305, __FUNCTION__))->common.chain)
4306	= build_omp_clause (input_location, OMP_CLAUSE_NOWAIT);
4307
4308	/* Initialize the loopvar. */
4309	TREE_VEC_ELT (init, 0)(((const_cast<tree > (tree_vec_elt_check ((init), (0) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4309, __FUNCTION__))))) = build2_v (MODIFY_EXPR, loop->loopvar[n],fold_build2_loc (input_location, MODIFY_EXPR, global_trees[TI_VOID_TYPE ], loop->loopvar[n], loop->from[n])
4310	loop->from[n])fold_build2_loc (input_location, MODIFY_EXPR, global_trees[TI_VOID_TYPE ], loop->loopvar[n], loop->from[n]);
4311	OMP_FOR_INIT (stmt)(((const_cast<tree> (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR), (OACC_LOOP), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4311, __FUNCTION__))), (2), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4311, __FUNCTION__))))) = init;
4312	/* The exit condition. */
4313	TREE_VEC_ELT (cond, 0)(((const_cast<tree > (tree_vec_elt_check ((cond), (0) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4313, __FUNCTION__))))) = build2_loc (input_location, LE_EXPR,
4314	logical_type_node,
4315	loop->loopvar[n], loop->to[n]);
4316	SET_EXPR_LOCATION (TREE_VEC_ELT (cond, 0), input_location)(expr_check ((((((const_cast<tree > (tree_vec_elt_check ((cond), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4316, __FUNCTION__))))))), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4316, __FUNCTION__))->exp.locus = (input_location);
4317	OMP_FOR_COND (stmt)(((const_cast<tree> (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR), (OACC_LOOP), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4317, __FUNCTION__))), (3), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4317, __FUNCTION__))))) = cond;
4318	/* Increment the loopvar. */
4319	tmp = build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4320	loop->loopvar[n], gfc_index_one_nodegfc_rank_cst[1]);
4321	TREE_VEC_ELT (incr, 0)(((const_cast<tree > (tree_vec_elt_check ((incr), (0) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4321, __FUNCTION__))))) = fold_build2_loc (input_location, MODIFY_EXPR,
4322	void_type_nodeglobal_trees[TI_VOID_TYPE], loop->loopvar[n], tmp);
4323	OMP_FOR_INCR (stmt)(((const_cast<tree> (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR), (OACC_LOOP), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4323, __FUNCTION__))), (4), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4323, __FUNCTION__))))) = incr;
4324
4325	ompws_flags &= ~OMPWS_CURR_SINGLEUNIT2;
4326	gfc_add_expr_to_block (&loop->code[n], stmt);
4327	}
4328	else
4329	{
4330	bool reverse_loop = (loop->reverse[n] == GFC_REVERSE_SET)
4331	&& (loop->temp_ss == NULL__null);
4332
4333	loopbody = gfc_finish_block (pbody);
4334
4335	if (reverse_loop)
4336	std::swap (loop->from[n], loop->to[n]);
4337
4338	/* Initialize the loopvar. */
4339	if (loop->loopvar[n] != loop->from[n])
4340	gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
4341
4342	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
4343
4344	/* Generate the loop body. */
4345	gfc_init_block (&block);
4346
4347	/* The exit condition. */
4348	cond = fold_build2_loc (input_location, reverse_loop ? LT_EXPR : GT_EXPR,
4349	logical_type_node, loop->loopvar[n], loop->to[n]);
4350	tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
4351	TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
4352	tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, tmp, build_empty_stmt (input_location));
4353	gfc_add_expr_to_block (&block, tmp);
4354
4355	/* The main body. */
4356	gfc_add_expr_to_block (&block, loopbody);
4357
4358	/* Increment the loopvar. */
4359	tmp = fold_build2_loc (input_location,
4360	reverse_loop ? MINUS_EXPR : PLUS_EXPR,
4361	gfc_array_index_type, loop->loopvar[n],
4362	gfc_index_one_nodegfc_rank_cst[1]);
4363
4364	gfc_add_modify (&block, loop->loopvar[n], tmp);
4365
4366	/* Build the loop. */
4367	tmp = gfc_finish_block (&block);
4368	tmp = build1_v (LOOP_EXPR, tmp)fold_build1_loc (input_location, LOOP_EXPR, global_trees[TI_VOID_TYPE ], tmp);
4369	gfc_add_expr_to_block (&loop->code[n], tmp);
4370
4371	/* Add the exit label. */
4372	tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
4373	gfc_add_expr_to_block (&loop->code[n], tmp);
4374	}
4375
4376	}
4377
4378
4379	/* Finishes and generates the loops for a scalarized expression. */
4380
4381	void
4382	gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body)
4383	{
4384	int dim;
4385	int n;
4386	gfc_ss *ss;
4387	stmtblock_t *pblock;
4388	tree tmp;
4389
4390	pblock = body;
4391	/* Generate the loops. */
4392	for (dim = 0; dim < loop->dimen; dim++)
4393	{
4394	n = loop->order[dim];
4395	gfc_trans_scalarized_loop_end (loop, n, pblock);
4396	loop->loopvar[n] = NULL_TREE(tree) __null;
4397	pblock = &loop->code[n];
4398	}
4399
4400	tmp = gfc_finish_block (pblock);
4401	gfc_add_expr_to_block (&loop->pre, tmp);
4402
4403	/* Clear all the used flags. */
4404	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4405	if (ss->parent == NULL__null)
4406	ss->info->useflags = 0;
4407	}
4408
4409
4410	/* Finish the main body of a scalarized expression, and start the secondary
4411	copying body. */
4412
4413	void
4414	gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
4415	{
4416	int dim;
4417	int n;
4418	stmtblock_t *pblock;
4419	gfc_ss *ss;
4420
4421	pblock = body;
4422	/* We finish as many loops as are used by the temporary. */
4423	for (dim = 0; dim < loop->temp_dim - 1; dim++)
4424	{
4425	n = loop->order[dim];
4426	gfc_trans_scalarized_loop_end (loop, n, pblock);
4427	loop->loopvar[n] = NULL_TREE(tree) __null;
4428	pblock = &loop->code[n];
4429	}
4430
4431	/* We don't want to finish the outermost loop entirely. */
4432	n = loop->order[loop->temp_dim - 1];
4433	gfc_trans_scalarized_loop_end (loop, n, pblock);
4434
4435	/* Restore the initial offsets. */
4436	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4437	{
4438	gfc_ss_type ss_type;
4439	gfc_ss_info *ss_info;
4440
4441	ss_info = ss->info;
4442
4443	if ((ss_info->useflags & 2) == 0)
4444	continue;
4445
4446	ss_type = ss_info->type;
4447	if (ss_type != GFC_SS_SECTION
4448	&& ss_type != GFC_SS_FUNCTION
4449	&& ss_type != GFC_SS_CONSTRUCTOR
4450	&& ss_type != GFC_SS_COMPONENT)
4451	continue;
4452
4453	ss_info->data.array.offset = ss_info->data.array.saved_offset;
4454	}
4455
4456	/* Restart all the inner loops we just finished. */
4457	for (dim = loop->temp_dim - 2; dim >= 0; dim--)
4458	{
4459	n = loop->order[dim];
4460
4461	gfc_start_block (&loop->code[n]);
4462
4463	loop->loopvar[n] = gfc_create_var (gfc_array_index_type, "Q");
4464
4465	gfc_trans_preloop_setup (loop, dim, 2, &loop->code[n]);
4466	}
4467
4468	/* Start a block for the secondary copying code. */
4469	gfc_start_block (body);
4470	}
4471
4472
4473	/* Precalculate (either lower or upper) bound of an array section.
4474	BLOCK: Block in which the (pre)calculation code will go.
4475	BOUNDS[DIM]: Where the bound value will be stored once evaluated.
4476	VALUES[DIM]: Specified bound (NULL <=> unspecified).
4477	DESC: Array descriptor from which the bound will be picked if unspecified
4478	(either lower or upper bound according to LBOUND). */
4479
4480	static void
4481	evaluate_bound (stmtblock_t block, tree bounds, gfc_expr ** values,
4482	tree desc, int dim, bool lbound, bool deferred)
4483	{
4484	gfc_se se;
4485	gfc_expr * input_val = values[dim];
4486	tree *output = &bounds[dim];
4487
4488
4489	if (input_val)
4490	{
4491	/* Specified section bound. */
4492	gfc_init_se (&se, NULL__null);
4493	gfc_conv_expr_type (&se, input_val, gfc_array_index_type);
4494	gfc_add_block_to_block (block, &se.pre);
4495	*output = se.expr;
4496	}
4497	else if (deferred && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4497, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4497, __FUNCTION__))->type_common.lang_flag_1))
4498	{
4499	/* The gfc_conv_array_lbound () routine returns a constant zero for
4500	deferred length arrays, which in the scalarizer wreaks havoc, when
4501	copying to a (newly allocated) one-based array.
4502	Keep returning the actual result in sync for both bounds. */
4503	*output = lbound ? gfc_conv_descriptor_lbound_get (desc,
4504	gfc_rank_cst[dim]):
4505	gfc_conv_descriptor_ubound_get (desc,
4506	gfc_rank_cst[dim]);
4507	}
4508	else
4509	{
4510	/* No specific bound specified so use the bound of the array. */
4511	*output = lbound ? gfc_conv_array_lbound (desc, dim) :
4512	gfc_conv_array_ubound (desc, dim);
4513	}
4514	output = gfc_evaluate_now (output, block);
4515	}
4516
4517
4518	/* Calculate the lower bound of an array section. */
4519
4520	static void
4521	gfc_conv_section_startstride (stmtblock_t * block, gfc_ss * ss, int dim)
4522	{
4523	gfc_expr *stride = NULL__null;
4524	tree desc;
4525	gfc_se se;
4526	gfc_array_info *info;
4527	gfc_array_ref *ar;
4528
4529	gcc_assert (ss->info->type == GFC_SS_SECTION)((void)(!(ss->info->type == GFC_SS_SECTION) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4529, __FUNCTION__), 0 : 0));
4530
4531	info = &ss->info->data.array;
4532	ar = &info->ref->u.ar;
4533
4534	if (ar->dimen_type[dim] == DIMEN_VECTOR)
4535	{
4536	/* We use a zero-based index to access the vector. */
4537	info->start[dim] = gfc_index_zero_nodegfc_rank_cst[0];
4538	info->end[dim] = NULL__null;
4539	info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
4540	return;
4541	}
4542
4543	gcc_assert (ar->dimen_type[dim] == DIMEN_RANGE((void)(!(ar->dimen_type[dim] == DIMEN_RANGE \|\| ar->dimen_type [dim] == DIMEN_THIS_IMAGE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4544, __FUNCTION__), 0 : 0))
4544	\|\| ar->dimen_type[dim] == DIMEN_THIS_IMAGE)((void)(!(ar->dimen_type[dim] == DIMEN_RANGE \|\| ar->dimen_type [dim] == DIMEN_THIS_IMAGE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4544, __FUNCTION__), 0 : 0));
4545	desc = info->descriptor;
4546	stride = ar->stride[dim];
4547
4548
4549	/* Calculate the start of the range. For vector subscripts this will
4550	be the range of the vector. */
4551	evaluate_bound (block, info->start, ar->start, desc, dim, true,
4552	ar->as->type == AS_DEFERRED);
4553
4554	/* Similarly calculate the end. Although this is not used in the
4555	scalarizer, it is needed when checking bounds and where the end
4556	is an expression with side-effects. */
4557	evaluate_bound (block, info->end, ar->end, desc, dim, false,
4558	ar->as->type == AS_DEFERRED);
4559
4560
4561	/* Calculate the stride. */
4562	if (stride == NULL__null)
4563	info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
4564	else
4565	{
4566	gfc_init_se (&se, NULL__null);
4567	gfc_conv_expr_type (&se, stride, gfc_array_index_type);
4568	gfc_add_block_to_block (block, &se.pre);
4569	info->stride[dim] = gfc_evaluate_now (se.expr, block);
4570	}
4571	}
4572
4573
4574	/* Calculates the range start and stride for a SS chain. Also gets the
4575	descriptor and data pointer. The range of vector subscripts is the size
4576	of the vector. Array bounds are also checked. */
4577
4578	void
4579	gfc_conv_ss_startstride (gfc_loopinfo * loop)
4580	{
4581	int n;
4582	tree tmp;
4583	gfc_ss *ss;
4584	tree desc;
4585
4586	gfc_loopinfo * const outer_loop = outermost_loop (loop);
4587
4588	loop->dimen = 0;
4589	/* Determine the rank of the loop. */
4590	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4591	{
4592	switch (ss->info->type)
4593	{
4594	case GFC_SS_SECTION:
4595	case GFC_SS_CONSTRUCTOR:
4596	case GFC_SS_FUNCTION:
4597	case GFC_SS_COMPONENT:
4598	loop->dimen = ss->dimen;
4599	goto done;
4600
4601	/* As usual, lbound and ubound are exceptions!. */
4602	case GFC_SS_INTRINSIC:
4603	switch (ss->info->expr->value.function.isym->id)
4604	{
4605	case GFC_ISYM_LBOUND:
4606	case GFC_ISYM_UBOUND:
4607	case GFC_ISYM_LCOBOUND:
4608	case GFC_ISYM_UCOBOUND:
4609	case GFC_ISYM_SHAPE:
4610	case GFC_ISYM_THIS_IMAGE:
4611	loop->dimen = ss->dimen;
4612	goto done;
4613
4614	default:
4615	break;
4616	}
4617
4618	default:
4619	break;
4620	}
4621	}
4622
4623	/* We should have determined the rank of the expression by now. If
4624	not, that's bad news. */
4625	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4625, __FUNCTION__));
4626
4627	done:
4628	/* Loop over all the SS in the chain. */
4629	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4630	{
4631	gfc_ss_info *ss_info;
4632	gfc_array_info *info;
4633	gfc_expr *expr;
4634
4635	ss_info = ss->info;
4636	expr = ss_info->expr;
4637	info = &ss_info->data.array;
4638
4639	if (expr && expr->shape && !info->shape)
4640	info->shape = expr->shape;
4641
4642	switch (ss_info->type)
4643	{
4644	case GFC_SS_SECTION:
4645	/* Get the descriptor for the array. If it is a cross loops array,
4646	we got the descriptor already in the outermost loop. */
4647	if (ss->parent == NULL__null)
4648	gfc_conv_ss_descriptor (&outer_loop->pre, ss,
4649	!loop->array_parameter);
4650
4651	for (n = 0; n < ss->dimen; n++)
4652	gfc_conv_section_startstride (&outer_loop->pre, ss, ss->dim[n]);
4653	break;
4654
4655	case GFC_SS_INTRINSIC:
4656	switch (expr->value.function.isym->id)
4657	{
4658	/* Fall through to supply start and stride. */
4659	case GFC_ISYM_LBOUND:
4660	case GFC_ISYM_UBOUND:
4661	/* This is the variant without DIM=... */
4662	gcc_assert (expr->value.function.actual->next->expr == NULL)((void)(!(expr->value.function.actual->next->expr == __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4662, __FUNCTION__), 0 : 0));
4663	/* Fall through. */
4664
4665	case GFC_ISYM_SHAPE:
4666	{
4667	gfc_expr *arg;
4668
4669	arg = expr->value.function.actual->expr;
4670	if (arg->rank == -1)
4671	{
4672	gfc_se se;
4673	tree rank, tmp;
4674
4675	/* The rank (hence the return value's shape) is unknown,
4676	we have to retrieve it. */
4677	gfc_init_se (&se, NULL__null);
4678	se.descriptor_only = 1;
4679	gfc_conv_expr (&se, arg);
4680	/* This is a bare variable, so there is no preliminary
4681	or cleanup code. */
4682	gcc_assert (se.pre.head == NULL_TREE((void)(!(se.pre.head == (tree) __null && se.post.head == (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4683, __FUNCTION__), 0 : 0))
4683	&& se.post.head == NULL_TREE)((void)(!(se.pre.head == (tree) __null && se.post.head == (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 4683, __FUNCTION__), 0 : 0));
4684	rank = gfc_conv_descriptor_rank (se.expr);
4685	tmp = fold_build2_loc (input_location, MINUS_EXPR,
4686	gfc_array_index_type,
4687	fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, rank )
4688	rank)fold_convert_loc (((location_t) 0), gfc_array_index_type, rank ),
4689	gfc_index_one_nodegfc_rank_cst[1]);
4690	info->end[0] = gfc_evaluate_now (tmp, &outer_loop->pre);
4691	info->start[0] = gfc_index_zero_nodegfc_rank_cst[0];
4692	info->stride[0] = gfc_index_one_nodegfc_rank_cst[1];
4693	continue;
4694	}
4695	/* Otherwise fall through GFC_SS_FUNCTION. */
4696	gcc_fallthrough ();
4697	}
4698	case GFC_ISYM_LCOBOUND:
4699	case GFC_ISYM_UCOBOUND:
4700	case GFC_ISYM_THIS_IMAGE:
4701	break;
4702
4703	default:
4704	continue;
4705	}
4706
4707	/* FALLTHRU */
4708	case GFC_SS_CONSTRUCTOR:
4709	case GFC_SS_FUNCTION:
4710	for (n = 0; n < ss->dimen; n++)
4711	{
4712	int dim = ss->dim[n];
4713
4714	info->start[dim] = gfc_index_zero_nodegfc_rank_cst[0];
4715	info->end[dim] = gfc_index_zero_nodegfc_rank_cst[0];
4716	info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
4717	}
4718	break;
4719
4720	default:
4721	break;
4722	}
4723	}
4724
4725	/* The rest is just runtime bounds checking. */
4726	if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
4727	{
4728	stmtblock_t block;
4729	tree lbound, ubound;
4730	tree end;
4731	tree size[GFC_MAX_DIMENSIONS15];
4732	tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3;
4733	gfc_array_info *info;
4734	char *msg;
4735	int dim;
4736
4737	gfc_start_block (&block);
4738
4739	for (n = 0; n < loop->dimen; n++)
4740	size[n] = NULL_TREE(tree) __null;
4741
4742	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4743	{
4744	stmtblock_t inner;
4745	gfc_ss_info *ss_info;
4746	gfc_expr *expr;
4747	locus *expr_loc;
4748	const char *expr_name;
4749
4750	ss_info = ss->info;
4751	if (ss_info->type != GFC_SS_SECTION)
4752	continue;
4753
4754	/* Catch allocatable lhs in f2003. */
4755	if (flag_realloc_lhsglobal_options.x_flag_realloc_lhs && ss->no_bounds_check)
4756	continue;
4757
4758	expr = ss_info->expr;
4759	expr_loc = &expr->where;
4760	expr_name = expr->symtree->name;
4761
4762	gfc_start_block (&inner);
4763
4764	/* TODO: range checking for mapped dimensions. */
4765	info = &ss_info->data.array;
4766
4767	/* This code only checks ranges. Elemental and vector
4768	dimensions are checked later. */
4769	for (n = 0; n < loop->dimen; n++)
4770	{
4771	bool check_upper;
4772
4773	dim = ss->dim[n];
4774	if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
4775	continue;
4776
4777	if (dim == info->ref->u.ar.dimen - 1
4778	&& info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
4779	check_upper = false;
4780	else
4781	check_upper = true;
4782
4783	/* Zero stride is not allowed. */
4784	tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
4785	info->stride[dim], gfc_index_zero_nodegfc_rank_cst[0]);
4786	msg = xasprintf ("Zero stride is not allowed, for dimension %d "
4787	"of array '%s'", dim + 1, expr_name);
4788	gfc_trans_runtime_check (true, false, tmp, &inner,
4789	expr_loc, msg);
4790	free (msg);
4791
4792	desc = info->descriptor;
4793
4794	/* This is the run-time equivalent of resolve.cc's
4795	check_dimension(). The logical is more readable there
4796	than it is here, with all the trees. */
4797	lbound = gfc_conv_array_lbound (desc, dim);
4798	end = info->end[dim];
4799	if (check_upper)
4800	ubound = gfc_conv_array_ubound (desc, dim);
4801	else
4802	ubound = NULL__null;
4803
4804	/* non_zerosized is true when the selected range is not
4805	empty. */
4806	stride_pos = fold_build2_loc (input_location, GT_EXPR,
4807	logical_type_node, info->stride[dim],
4808	gfc_index_zero_nodegfc_rank_cst[0]);
4809	tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
4810	info->start[dim], end);
4811	stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4812	logical_type_node, stride_pos, tmp);
4813
4814	stride_neg = fold_build2_loc (input_location, LT_EXPR,
4815	logical_type_node,
4816	info->stride[dim], gfc_index_zero_nodegfc_rank_cst[0]);
4817	tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
4818	info->start[dim], end);
4819	stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4820	logical_type_node,
4821	stride_neg, tmp);
4822	non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR,
4823	logical_type_node,
4824	stride_pos, stride_neg);
4825
4826	/* Check the start of the range against the lower and upper
4827	bounds of the array, if the range is not empty.
4828	If upper bound is present, include both bounds in the
4829	error message. */
4830	if (check_upper)
4831	{
4832	tmp = fold_build2_loc (input_location, LT_EXPR,
4833	logical_type_node,
4834	info->start[dim], lbound);
4835	tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4836	logical_type_node,
4837	non_zerosized, tmp);
4838	tmp2 = fold_build2_loc (input_location, GT_EXPR,
4839	logical_type_node,
4840	info->start[dim], ubound);
4841	tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4842	logical_type_node,
4843	non_zerosized, tmp2);
4844	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4845	"outside of expected range (%%ld:%%ld)",
4846	dim + 1, expr_name);
4847	gfc_trans_runtime_check (true, false, tmp, &inner,
4848	expr_loc, msg,
4849	fold_convert (long_integer_type_node, info->start[dim])fold_convert_loc (((location_t) 0), integer_types[itk_long], info ->start[dim]),
4850	fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound ),
4851	fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound ));
4852	gfc_trans_runtime_check (true, false, tmp2, &inner,
4853	expr_loc, msg,
4854	fold_convert (long_integer_type_node, info->start[dim])fold_convert_loc (((location_t) 0), integer_types[itk_long], info ->start[dim]),
4855	fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound ),
4856	fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound ));
4857	free (msg);
4858	}
4859	else
4860	{
4861	tmp = fold_build2_loc (input_location, LT_EXPR,
4862	logical_type_node,
4863	info->start[dim], lbound);
4864	tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4865	logical_type_node, non_zerosized, tmp);
4866	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4867	"below lower bound of %%ld",
4868	dim + 1, expr_name);
4869	gfc_trans_runtime_check (true, false, tmp, &inner,
4870	expr_loc, msg,
4871	fold_convert (long_integer_type_node, info->start[dim])fold_convert_loc (((location_t) 0), integer_types[itk_long], info ->start[dim]),
4872	fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound ));
4873	free (msg);
4874	}
4875
4876	/* Compute the last element of the range, which is not
4877	necessarily "end" (think 0:5:3, which doesn't contain 5)
4878	and check it against both lower and upper bounds. */
4879
4880	tmp = fold_build2_loc (input_location, MINUS_EXPR,
4881	gfc_array_index_type, end,
4882	info->start[dim]);
4883	tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
4884	gfc_array_index_type, tmp,
4885	info->stride[dim]);
4886	tmp = fold_build2_loc (input_location, MINUS_EXPR,
4887	gfc_array_index_type, end, tmp);
4888	tmp2 = fold_build2_loc (input_location, LT_EXPR,
4889	logical_type_node, tmp, lbound);
4890	tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4891	logical_type_node, non_zerosized, tmp2);
4892	if (check_upper)
4893	{
4894	tmp3 = fold_build2_loc (input_location, GT_EXPR,
4895	logical_type_node, tmp, ubound);
4896	tmp3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4897	logical_type_node, non_zerosized, tmp3);
4898	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4899	"outside of expected range (%%ld:%%ld)",
4900	dim + 1, expr_name);
4901	gfc_trans_runtime_check (true, false, tmp2, &inner,
4902	expr_loc, msg,
4903	fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp ),
4904	fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound ),
4905	fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound ));
4906	gfc_trans_runtime_check (true, false, tmp3, &inner,
4907	expr_loc, msg,
4908	fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp ),
4909	fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound ),
4910	fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound ));
4911	free (msg);
4912	}
4913	else
4914	{
4915	msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4916	"below lower bound of %%ld",
4917	dim + 1, expr_name);
4918	gfc_trans_runtime_check (true, false, tmp2, &inner,
4919	expr_loc, msg,
4920	fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp ),
4921	fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound ));
4922	free (msg);
4923	}
4924
4925	/* Check the section sizes match. */
4926	tmp = fold_build2_loc (input_location, MINUS_EXPR,
4927	gfc_array_index_type, end,
4928	info->start[dim]);
4929	tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR,
4930	gfc_array_index_type, tmp,
4931	info->stride[dim]);
4932	tmp = fold_build2_loc (input_location, PLUS_EXPR,
4933	gfc_array_index_type,
4934	gfc_index_one_nodegfc_rank_cst[1], tmp);
4935	tmp = fold_build2_loc (input_location, MAX_EXPR,
4936	gfc_array_index_type, tmp,
4937	build_int_cst (gfc_array_index_type, 0));
4938	/* We remember the size of the first section, and check all the
4939	others against this. */
4940	if (size[n])
4941	{
4942	tmp3 = fold_build2_loc (input_location, NE_EXPR,
4943	logical_type_node, tmp, size[n]);
4944	msg = xasprintf ("Array bound mismatch for dimension %d "
4945	"of array '%s' (%%ld/%%ld)",
4946	dim + 1, expr_name);
4947
4948	gfc_trans_runtime_check (true, false, tmp3, &inner,
4949	expr_loc, msg,
4950	fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp ),
4951	fold_convert (long_integer_type_node, size[n])fold_convert_loc (((location_t) 0), integer_types[itk_long], size [n]));
4952
4953	free (msg);
4954	}
4955	else
4956	size[n] = gfc_evaluate_now (tmp, &inner);
4957	}
4958
4959	tmp = gfc_finish_block (&inner);
4960
4961	/* For optional arguments, only check bounds if the argument is
4962	present. */
4963	if ((expr->symtree->n.sym->attr.optional
4964	\|\| expr->symtree->n.sym->attr.not_always_present)
4965	&& expr->symtree->n.sym->attr.dummy)
4966	tmp = build3_v (COND_EXPR,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt (input_location))
4967	gfc_conv_expr_present (expr->symtree->n.sym),fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt (input_location))
4968	tmp, build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt (input_location));
4969
4970	gfc_add_expr_to_block (&block, tmp);
4971
4972	}
4973
4974	tmp = gfc_finish_block (&block);
4975	gfc_add_expr_to_block (&outer_loop->pre, tmp);
4976	}
4977
4978	for (loop = loop->nested; loop; loop = loop->next)
4979	gfc_conv_ss_startstride (loop);
4980	}
4981
4982	/* Return true if both symbols could refer to the same data object. Does
4983	not take account of aliasing due to equivalence statements. */
4984
4985	static int
4986	symbols_could_alias (gfc_symbol lsym, gfc_symbol rsym, bool lsym_pointer,
4987	bool lsym_target, bool rsym_pointer, bool rsym_target)
4988	{
4989	/* Aliasing isn't possible if the symbols have different base types. */
4990	if (gfc_compare_types (&lsym->ts, &rsym->ts) == 0)
4991	return 0;
4992
4993	/* Pointers can point to other pointers and target objects. */
4994
4995	if ((lsym_pointer && (rsym_pointer \|\| rsym_target))
4996	\|\| (rsym_pointer && (lsym_pointer \|\| lsym_target)))
4997	return 1;
4998
4999	/* Special case: Argument association, cf. F90 12.4.1.6, F2003 12.4.1.7
5000	and F2008 12.5.2.13 items 3b and 4b. The pointer case (a) is already
5001	checked above. */
5002	if (lsym_target && rsym_target
5003	&& ((lsym->attr.dummy && !lsym->attr.contiguous
5004	&& (!lsym->attr.dimension \|\| lsym->as->type == AS_ASSUMED_SHAPE))
5005	\|\| (rsym->attr.dummy && !rsym->attr.contiguous
5006	&& (!rsym->attr.dimension
5007	\|\| rsym->as->type == AS_ASSUMED_SHAPE))))
5008	return 1;
5009
5010	return 0;
5011	}
5012
5013
5014	/* Return true if the two SS could be aliased, i.e. both point to the same data
5015	object. */
5016	/* TODO: resolve aliases based on frontend expressions. */
5017
5018	static int
5019	gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
5020	{
5021	gfc_ref *lref;
5022	gfc_ref *rref;
5023	gfc_expr lexpr, rexpr;
5024	gfc_symbol *lsym;
5025	gfc_symbol *rsym;
5026	bool lsym_pointer, lsym_target, rsym_pointer, rsym_target;
5027
5028	lexpr = lss->info->expr;
5029	rexpr = rss->info->expr;
5030
5031	lsym = lexpr->symtree->n.sym;
5032	rsym = rexpr->symtree->n.sym;
5033
5034	lsym_pointer = lsym->attr.pointer;
5035	lsym_target = lsym->attr.target;
5036	rsym_pointer = rsym->attr.pointer;
5037	rsym_target = rsym->attr.target;
5038
5039	if (symbols_could_alias (lsym, rsym, lsym_pointer, lsym_target,
5040	rsym_pointer, rsym_target))
5041	return 1;
5042
5043	if (rsym->ts.type != BT_DERIVED && rsym->ts.type != BT_CLASS
5044	&& lsym->ts.type != BT_DERIVED && lsym->ts.type != BT_CLASS)
5045	return 0;
5046
5047	/* For derived types we must check all the component types. We can ignore
5048	array references as these will have the same base type as the previous
5049	component ref. */
5050	for (lref = lexpr->ref; lref != lss->info->data.array.ref; lref = lref->next)
5051	{
5052	if (lref->type != REF_COMPONENT)
5053	continue;
5054
5055	lsym_pointer = lsym_pointer \|\| lref->u.c.sym->attr.pointer;
5056	lsym_target = lsym_target \|\| lref->u.c.sym->attr.target;
5057
5058	if (symbols_could_alias (lref->u.c.sym, rsym, lsym_pointer, lsym_target,
5059	rsym_pointer, rsym_target))
5060	return 1;
5061
5062	if ((lsym_pointer && (rsym_pointer \|\| rsym_target))
5063	\|\| (rsym_pointer && (lsym_pointer \|\| lsym_target)))
5064	{
5065	if (gfc_compare_types (&lref->u.c.component->ts,
5066	&rsym->ts))
5067	return 1;
5068	}
5069
5070	for (rref = rexpr->ref; rref != rss->info->data.array.ref;
5071	rref = rref->next)
5072	{
5073	if (rref->type != REF_COMPONENT)
5074	continue;
5075
5076	rsym_pointer = rsym_pointer \|\| rref->u.c.sym->attr.pointer;
5077	rsym_target = lsym_target \|\| rref->u.c.sym->attr.target;
5078
5079	if (symbols_could_alias (lref->u.c.sym, rref->u.c.sym,
5080	lsym_pointer, lsym_target,
5081	rsym_pointer, rsym_target))
5082	return 1;
5083
5084	if ((lsym_pointer && (rsym_pointer \|\| rsym_target))
5085	\|\| (rsym_pointer && (lsym_pointer \|\| lsym_target)))
5086	{
5087	if (gfc_compare_types (&lref->u.c.component->ts,
5088	&rref->u.c.sym->ts))
5089	return 1;
5090	if (gfc_compare_types (&lref->u.c.sym->ts,
5091	&rref->u.c.component->ts))
5092	return 1;
5093	if (gfc_compare_types (&lref->u.c.component->ts,
5094	&rref->u.c.component->ts))
5095	return 1;
5096	}
5097	}
5098	}
5099
5100	lsym_pointer = lsym->attr.pointer;
5101	lsym_target = lsym->attr.target;
5102
5103	for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next)
5104	{
5105	if (rref->type != REF_COMPONENT)
5106	break;
5107
5108	rsym_pointer = rsym_pointer \|\| rref->u.c.sym->attr.pointer;
5109	rsym_target = lsym_target \|\| rref->u.c.sym->attr.target;
5110
5111	if (symbols_could_alias (rref->u.c.sym, lsym,
5112	lsym_pointer, lsym_target,
5113	rsym_pointer, rsym_target))
5114	return 1;
5115
5116	if ((lsym_pointer && (rsym_pointer \|\| rsym_target))
5117	\|\| (rsym_pointer && (lsym_pointer \|\| lsym_target)))
5118	{
5119	if (gfc_compare_types (&lsym->ts, &rref->u.c.component->ts))
5120	return 1;
5121	}
5122	}
5123
5124	return 0;
5125	}
5126
5127
5128	/* Resolve array data dependencies. Creates a temporary if required. */
5129	/* TODO: Calc dependencies with gfc_expr rather than gfc_ss, and move to
5130	dependency.cc. */
5131
5132	void
5133	gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
5134	gfc_ss * rss)
5135	{
5136	gfc_ss *ss;
5137	gfc_ref *lref;
5138	gfc_ref *rref;
5139	gfc_ss_info *ss_info;
5140	gfc_expr *dest_expr;
5141	gfc_expr *ss_expr;
5142	int nDepend = 0;
5143	int i, j;
5144
5145	loop->temp_ss = NULL__null;
5146	dest_expr = dest->info->expr;
5147
5148	for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
5149	{
5150	ss_info = ss->info;
5151	ss_expr = ss_info->expr;
5152
5153	if (ss_info->array_outer_dependency)
5154	{
5155	nDepend = 1;
5156	break;
5157	}
5158
5159	if (ss_info->type != GFC_SS_SECTION)
5160	{
5161	if (flag_realloc_lhsglobal_options.x_flag_realloc_lhs
5162	&& dest_expr != ss_expr
5163	&& gfc_is_reallocatable_lhs (dest_expr)
5164	&& ss_expr->rank)
5165	nDepend = gfc_check_dependency (dest_expr, ss_expr, true);
5166
5167	/* Check for cases like c(:)(1:2) = c(2)(2:3) */
5168	if (!nDepend && dest_expr->rank > 0
5169	&& dest_expr->ts.type == BT_CHARACTER
5170	&& ss_expr->expr_type == EXPR_VARIABLE)
5171
5172	nDepend = gfc_check_dependency (dest_expr, ss_expr, false);
5173
5174	if (ss_info->type == GFC_SS_REFERENCE
5175	&& gfc_check_dependency (dest_expr, ss_expr, false))
5176	ss_info->data.scalar.needs_temporary = 1;
5177
5178	if (nDepend)
5179	break;
5180	else
5181	continue;
5182	}
5183
5184	if (dest_expr->symtree->n.sym != ss_expr->symtree->n.sym)
5185	{
5186	if (gfc_could_be_alias (dest, ss)
5187	\|\| gfc_are_equivalenced_arrays (dest_expr, ss_expr))
5188	{
5189	nDepend = 1;
5190	break;
5191	}
5192	}
5193	else
5194	{
5195	lref = dest_expr->ref;
5196	rref = ss_expr->ref;
5197
5198	nDepend = gfc_dep_resolver (lref, rref, &loop->reverse[0]);
5199
5200	if (nDepend == 1)
5201	break;
5202
5203	for (i = 0; i < dest->dimen; i++)
5204	for (j = 0; j < ss->dimen; j++)
5205	if (i != j
5206	&& dest->dim[i] == ss->dim[j])
5207	{
5208	/* If we don't access array elements in the same order,
5209	there is a dependency. */
5210	nDepend = 1;
5211	goto temporary;
5212	}
5213	#if 0
5214	/* TODO : loop shifting. */
5215	if (nDepend == 1)
5216	{
5217	/* Mark the dimensions for LOOP SHIFTING */
5218	for (n = 0; n < loop->dimen; n++)
5219	{
5220	int dim = dest->data.info.dim[n];
5221
5222	if (lref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
5223	depends[n] = 2;
5224	else if (! gfc_is_same_range (&lref->u.ar,
5225	&rref->u.ar, dim, 0))
5226	depends[n] = 1;
5227	}
5228
5229	/* Put all the dimensions with dependencies in the
5230	innermost loops. */
5231	dim = 0;
5232	for (n = 0; n < loop->dimen; n++)
5233	{
5234	gcc_assert (loop->order[n] == n)((void)(!(loop->order[n] == n) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5234, __FUNCTION__), 0 : 0));
5235	if (depends[n])
5236	loop->order[dim++] = n;
5237	}
5238	for (n = 0; n < loop->dimen; n++)
5239	{
5240	if (! depends[n])
5241	loop->order[dim++] = n;
5242	}
5243
5244	gcc_assert (dim == loop->dimen)((void)(!(dim == loop->dimen) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5244, __FUNCTION__), 0 : 0));
5245	break;
5246	}
5247	#endif
5248	}
5249	}
5250
5251	temporary:
5252
5253	if (nDepend == 1)
5254	{
5255	tree base_type = gfc_typenode_for_spec (&dest_expr->ts);
5256	if (GFC_ARRAY_TYPE_P (base_type)((tree_class_check ((base_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5256, __FUNCTION__))->type_common.lang_flag_2)
5257	\|\| GFC_DESCRIPTOR_TYPE_P (base_type)((tree_class_check ((base_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5257, __FUNCTION__))->type_common.lang_flag_1))
5258	base_type = gfc_get_element_type (base_type);
5259	loop->temp_ss = gfc_get_temp_ss (base_type, dest->info->string_length,
5260	loop->dimen);
5261	gfc_add_ss_to_loop (loop, loop->temp_ss);
5262	}
5263	else
5264	loop->temp_ss = NULL__null;
5265	}
5266
5267
5268	/* Browse through each array's information from the scalarizer and set the loop
5269	bounds according to the "best" one (per dimension), i.e. the one which
5270	provides the most information (constant bounds, shape, etc.). */
5271
5272	static void
5273	set_loop_bounds (gfc_loopinfo *loop)
5274	{
5275	int n, dim, spec_dim;
5276	gfc_array_info *info;
5277	gfc_array_info *specinfo;
5278	gfc_ss *ss;
5279	tree tmp;
5280	gfc_ss **loopspec;
5281	bool dynamic[GFC_MAX_DIMENSIONS15];
5282	mpz_t *cshape;
5283	mpz_t i;
5284	bool nonoptional_arr;
5285
5286	gfc_loopinfo * const outer_loop = outermost_loop (loop);
5287
5288	loopspec = loop->specloop;
5289
5290	mpz_init__gmpz_init (i);
5291	for (n = 0; n < loop->dimen; n++)
5292	{
5293	loopspec[n] = NULL__null;
5294	dynamic[n] = false;
5295
5296	/* If there are both optional and nonoptional array arguments, scalarize
5297	over the nonoptional; otherwise, it does not matter as then all
5298	(optional) arrays have to be present per F2008, 125.2.12p3(6). */
5299
5300	nonoptional_arr = false;
5301
5302	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
5303	if (ss->info->type != GFC_SS_SCALAR && ss->info->type != GFC_SS_TEMP
5304	&& ss->info->type != GFC_SS_REFERENCE && !ss->info->can_be_null_ref)
5305	{
5306	nonoptional_arr = true;
5307	break;
5308	}
5309
5310	/* We use one SS term, and use that to determine the bounds of the
5311	loop for this dimension. We try to pick the simplest term. */
5312	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
5313	{
5314	gfc_ss_type ss_type;
5315
5316	ss_type = ss->info->type;
5317	if (ss_type == GFC_SS_SCALAR
5318	\|\| ss_type == GFC_SS_TEMP
5319	\|\| ss_type == GFC_SS_REFERENCE
5320	\|\| (ss->info->can_be_null_ref && nonoptional_arr))
5321	continue;
5322
5323	info = &ss->info->data.array;
5324	dim = ss->dim[n];
5325
5326	if (loopspec[n] != NULL__null)
5327	{
5328	specinfo = &loopspec[n]->info->data.array;
5329	spec_dim = loopspec[n]->dim[n];
5330	}
5331	else
5332	{
5333	/* Silence uninitialized warnings. */
5334	specinfo = NULL__null;
5335	spec_dim = 0;
5336	}
5337
5338	if (info->shape)
5339	{
5340	/* The frontend has worked out the size for us. */
5341	if (!loopspec[n]
5342	\|\| !specinfo->shape
5343	\|\| !integer_zerop (specinfo->start[spec_dim]))
5344	/* Prefer zero-based descriptors if possible. */
5345	loopspec[n] = ss;
5346	continue;
5347	}
5348
5349	if (ss_type == GFC_SS_CONSTRUCTOR)
5350	{
5351	gfc_constructor_base base;
5352	/* An unknown size constructor will always be rank one.
5353	Higher rank constructors will either have known shape,
5354	or still be wrapped in a call to reshape. */
5355	gcc_assert (loop->dimen == 1)((void)(!(loop->dimen == 1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5355, __FUNCTION__), 0 : 0));
5356
5357	/* Always prefer to use the constructor bounds if the size
5358	can be determined at compile time. Prefer not to otherwise,
5359	since the general case involves realloc, and it's better to
5360	avoid that overhead if possible. */
5361	base = ss->info->expr->value.constructor;
5362	dynamic[n] = gfc_get_array_constructor_size (&i, base);
5363	if (!dynamic[n] \|\| !loopspec[n])
5364	loopspec[n] = ss;
5365	continue;
5366	}
5367
5368	/* Avoid using an allocatable lhs in an assignment, since
5369	there might be a reallocation coming. */
5370	if (loopspec[n] && ss->is_alloc_lhs)
5371	continue;
5372
5373	if (!loopspec[n])
5374	loopspec[n] = ss;
5375	/* Criteria for choosing a loop specifier (most important first):
5376	doesn't need realloc
5377	stride of one
5378	known stride
5379	known lower bound
5380	known upper bound
5381	*/
5382	else if (loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n])
5383	loopspec[n] = ss;
5384	else if (integer_onep (info->stride[dim])
5385	&& !integer_onep (specinfo->stride[spec_dim]))
5386	loopspec[n] = ss;
5387	else if (INTEGER_CST_P (info->stride[dim])(((enum tree_code) (info->stride[dim])->base.code) == INTEGER_CST )
5388	&& !INTEGER_CST_P (specinfo->stride[spec_dim])(((enum tree_code) (specinfo->stride[spec_dim])->base.code ) == INTEGER_CST))
5389	loopspec[n] = ss;
5390	else if (INTEGER_CST_P (info->start[dim])(((enum tree_code) (info->start[dim])->base.code) == INTEGER_CST )
5391	&& !INTEGER_CST_P (specinfo->start[spec_dim])(((enum tree_code) (specinfo->start[spec_dim])->base.code ) == INTEGER_CST)
5392	&& integer_onep (info->stride[dim])
5393	== integer_onep (specinfo->stride[spec_dim])
5394	&& INTEGER_CST_P (info->stride[dim])(((enum tree_code) (info->stride[dim])->base.code) == INTEGER_CST )
5395	== INTEGER_CST_P (specinfo->stride[spec_dim])(((enum tree_code) (specinfo->stride[spec_dim])->base.code ) == INTEGER_CST))
5396	loopspec[n] = ss;
5397	/* We don't work out the upper bound.
5398	else if (INTEGER_CST_P (info->finish[n])
5399	&& ! INTEGER_CST_P (specinfo->finish[n]))
5400	loopspec[n] = ss; */
5401	}
5402
5403	/* We should have found the scalarization loop specifier. If not,
5404	that's bad news. */
5405	gcc_assert (loopspec[n])((void)(!(loopspec[n]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5405, __FUNCTION__), 0 : 0));
5406
5407	info = &loopspec[n]->info->data.array;
5408	dim = loopspec[n]->dim[n];
5409
5410	/* Set the extents of this range. */
5411	cshape = info->shape;
5412	if (cshape && INTEGER_CST_P (info->start[dim])(((enum tree_code) (info->start[dim])->base.code) == INTEGER_CST )
5413	&& INTEGER_CST_P (info->stride[dim])(((enum tree_code) (info->stride[dim])->base.code) == INTEGER_CST ))
5414	{
5415	loop->from[n] = info->start[dim];
5416	mpz_set__gmpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]);
5417	mpz_sub_ui__gmpz_sub_ui (i, i, 1);
5418	/* To = from + (size - 1) * stride. */
5419	tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
5420	if (!integer_onep (info->stride[dim]))
5421	tmp = fold_build2_loc (input_location, MULT_EXPR,
5422	gfc_array_index_type, tmp,
5423	info->stride[dim]);
5424	loop->to[n] = fold_build2_loc (input_location, PLUS_EXPR,
5425	gfc_array_index_type,
5426	loop->from[n], tmp);
5427	}
5428	else
5429	{
5430	loop->from[n] = info->start[dim];
5431	switch (loopspec[n]->info->type)
5432	{
5433	case GFC_SS_CONSTRUCTOR:
5434	/* The upper bound is calculated when we expand the
5435	constructor. */
5436	gcc_assert (loop->to[n] == NULL_TREE)((void)(!(loop->to[n] == (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5436, __FUNCTION__), 0 : 0));
5437	break;
5438
5439	case GFC_SS_SECTION:
5440	/* Use the end expression if it exists and is not constant,
5441	so that it is only evaluated once. */
5442	loop->to[n] = info->end[dim];
5443	break;
5444
5445	case GFC_SS_FUNCTION:
5446	/* The loop bound will be set when we generate the call. */
5447	gcc_assert (loop->to[n] == NULL_TREE)((void)(!(loop->to[n] == (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5447, __FUNCTION__), 0 : 0));
5448	break;
5449
5450	case GFC_SS_INTRINSIC:
5451	{
5452	gfc_expr *expr = loopspec[n]->info->expr;
5453
5454	/* The {l,u}bound of an assumed rank. */
5455	if (expr->value.function.isym->id == GFC_ISYM_SHAPE)
5456	gcc_assert (expr->value.function.actual->expr->rank == -1)((void)(!(expr->value.function.actual->expr->rank == -1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5456, __FUNCTION__), 0 : 0));
5457	else
5458	gcc_assert ((expr->value.function.isym->id == GFC_ISYM_LBOUND((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND \|\| expr->value.function.isym->id == GFC_ISYM_UBOUND) && expr->value.function.actual->next->expr == __null && expr->value.function.actual->expr->rank == -1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5461, __FUNCTION__), 0 : 0))
5459	\|\| expr->value.function.isym->id == GFC_ISYM_UBOUND)((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND \|\| expr->value.function.isym->id == GFC_ISYM_UBOUND) && expr->value.function.actual->next->expr == __null && expr->value.function.actual->expr->rank == -1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5461, __FUNCTION__), 0 : 0))
5460	&& expr->value.function.actual->next->expr == NULL((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND \|\| expr->value.function.isym->id == GFC_ISYM_UBOUND) && expr->value.function.actual->next->expr == __null && expr->value.function.actual->expr->rank == -1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5461, __FUNCTION__), 0 : 0))
5461	&& expr->value.function.actual->expr->rank == -1)((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND \|\| expr->value.function.isym->id == GFC_ISYM_UBOUND) && expr->value.function.actual->next->expr == __null && expr->value.function.actual->expr->rank == -1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5461, __FUNCTION__), 0 : 0));
5462
5463	loop->to[n] = info->end[dim];
5464	break;
5465	}
5466
5467	case GFC_SS_COMPONENT:
5468	{
5469	if (info->end[dim] != NULL_TREE(tree) __null)
5470	{
5471	loop->to[n] = info->end[dim];
5472	break;
5473	}
5474	else
5475	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5475, __FUNCTION__));
5476	}
5477
5478	default:
5479	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5479, __FUNCTION__));
5480	}
5481	}
5482
5483	/* Transform everything so we have a simple incrementing variable. */
5484	if (integer_onep (info->stride[dim]))
5485	info->delta[dim] = gfc_index_zero_nodegfc_rank_cst[0];
5486	else
5487	{
5488	/* Set the delta for this section. */
5489	info->delta[dim] = gfc_evaluate_now (loop->from[n], &outer_loop->pre);
5490	/* Number of iterations is (end - start + step) / step.
5491	with start = 0, this simplifies to
5492	last = end / step;
5493	for (i = 0; i<=last; i++){...}; */
5494	tmp = fold_build2_loc (input_location, MINUS_EXPR,
5495	gfc_array_index_type, loop->to[n],
5496	loop->from[n]);
5497	tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR,
5498	gfc_array_index_type, tmp, info->stride[dim]);
5499	tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
5500	tmp, build_int_cst (gfc_array_index_type, -1));
5501	loop->to[n] = gfc_evaluate_now (tmp, &outer_loop->pre);
5502	/* Make the loop variable start at 0. */
5503	loop->from[n] = gfc_index_zero_nodegfc_rank_cst[0];
5504	}
5505	}
5506	mpz_clear__gmpz_clear (i);
5507
5508	for (loop = loop->nested; loop; loop = loop->next)
5509	set_loop_bounds (loop);
5510	}
5511
5512
5513	/* Initialize the scalarization loop. Creates the loop variables. Determines
5514	the range of the loop variables. Creates a temporary if required.
5515	Also generates code for scalar expressions which have been
5516	moved outside the loop. */
5517
5518	void
5519	gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
5520	{
5521	gfc_ss *tmp_ss;
5522	tree tmp;
5523
5524	set_loop_bounds (loop);
5525
5526	/* Add all the scalar code that can be taken out of the loops.
5527	This may include calculating the loop bounds, so do it before
5528	allocating the temporary. */
5529	gfc_add_loop_ss_code (loop, loop->ss, false, where);
5530
5531	tmp_ss = loop->temp_ss;
5532	/* If we want a temporary then create it. */
5533	if (tmp_ss != NULL__null)
5534	{
5535	gfc_ss_info *tmp_ss_info;
5536
5537	tmp_ss_info = tmp_ss->info;
5538	gcc_assert (tmp_ss_info->type == GFC_SS_TEMP)((void)(!(tmp_ss_info->type == GFC_SS_TEMP) ? fancy_abort ( "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5538, __FUNCTION__), 0 : 0));
5539	gcc_assert (loop->parent == NULL)((void)(!(loop->parent == __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5539, __FUNCTION__), 0 : 0));
5540
5541	/* Make absolutely sure that this is a complete type. */
5542	if (tmp_ss_info->string_length)
5543	tmp_ss_info->data.temp.type
5544	= gfc_get_character_type_len_for_eltype
5545	(TREE_TYPE (tmp_ss_info->data.temp.type)((contains_struct_check ((tmp_ss_info->data.temp.type), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5545, __FUNCTION__))->typed.type),
5546	tmp_ss_info->string_length);
5547
5548	tmp = tmp_ss_info->data.temp.type;
5549	memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info));
5550	tmp_ss_info->type = GFC_SS_SECTION;
5551
5552	gcc_assert (tmp_ss->dimen != 0)((void)(!(tmp_ss->dimen != 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5552, __FUNCTION__), 0 : 0));
5553
5554	gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
5555	NULL_TREE(tree) __null, false, true, false, where);
5556	}
5557
5558	/* For array parameters we don't have loop variables, so don't calculate the
5559	translations. */
5560	if (!loop->array_parameter)
5561	gfc_set_delta (loop);
5562	}
5563
5564
5565	/* Calculates how to transform from loop variables to array indices for each
5566	array: once loop bounds are chosen, sets the difference (DELTA field) between
5567	loop bounds and array reference bounds, for each array info. */
5568
5569	void
5570	gfc_set_delta (gfc_loopinfo *loop)
5571	{
5572	gfc_ss ss, *loopspec;
5573	gfc_array_info *info;
5574	tree tmp;
5575	int n, dim;
5576
5577	gfc_loopinfo * const outer_loop = outermost_loop (loop);
5578
5579	loopspec = loop->specloop;
5580
5581	/* Calculate the translation from loop variables to array indices. */
5582	for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
5583	{
5584	gfc_ss_type ss_type;
5585
5586	ss_type = ss->info->type;
5587	if (ss_type != GFC_SS_SECTION
5588	&& ss_type != GFC_SS_COMPONENT
5589	&& ss_type != GFC_SS_CONSTRUCTOR)
5590	continue;
5591
5592	info = &ss->info->data.array;
5593
5594	for (n = 0; n < ss->dimen; n++)
5595	{
5596	/* If we are specifying the range the delta is already set. */
5597	if (loopspec[n] != ss)
5598	{
5599	dim = ss->dim[n];
5600
5601	/* Calculate the offset relative to the loop variable.
5602	First multiply by the stride. */
5603	tmp = loop->from[n];
5604	if (!integer_onep (info->stride[dim]))
5605	tmp = fold_build2_loc (input_location, MULT_EXPR,
5606	gfc_array_index_type,
5607	tmp, info->stride[dim]);
5608
5609	/* Then subtract this from our starting value. */
5610	tmp = fold_build2_loc (input_location, MINUS_EXPR,
5611	gfc_array_index_type,
5612	info->start[dim], tmp);
5613
5614	info->delta[dim] = gfc_evaluate_now (tmp, &outer_loop->pre);
5615	}
5616	}
5617	}
5618
5619	for (loop = loop->nested; loop; loop = loop->next)
5620	gfc_set_delta (loop);
5621	}
5622
5623
5624	/* Calculate the size of a given array dimension from the bounds. This
5625	is simply (ubound - lbound + 1) if this expression is positive
5626	or 0 if it is negative (pick either one if it is zero). Optionally
5627	(if or_expr is present) OR the (expression != 0) condition to it. */
5628
5629	tree
5630	gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
5631	{
5632	tree res;
5633	tree cond;
5634
5635	/* Calculate (ubound - lbound + 1). */
5636	res = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
5637	ubound, lbound);
5638	res = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, res,
5639	gfc_index_one_nodegfc_rank_cst[1]);
5640
5641	/* Check whether the size for this dimension is negative. */
5642	cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res,
5643	gfc_index_zero_nodegfc_rank_cst[0]);
5644	res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
5645	gfc_index_zero_nodegfc_rank_cst[0], res);
5646
5647	/* Build OR expression. */
5648	if (or_expr)
5649	*or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
5650	logical_type_node, *or_expr, cond);
5651
5652	return res;
5653	}
5654
5655
5656	/* For an array descriptor, get the total number of elements. This is just
5657	the product of the extents along from_dim to to_dim. */
5658
5659	static tree
5660	gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim)
5661	{
5662	tree res;
5663	int dim;
5664
5665	res = gfc_index_one_nodegfc_rank_cst[1];
5666
5667	for (dim = from_dim; dim < to_dim; ++dim)
5668	{
5669	tree lbound;
5670	tree ubound;
5671	tree extent;
5672
5673	lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
5674	ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
5675
5676	extent = gfc_conv_array_extent_dim (lbound, ubound, NULL__null);
5677	res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
5678	res, extent);
5679	}
5680
5681	return res;
5682	}
5683
5684
5685	/* Full size of an array. */
5686
5687	tree
5688	gfc_conv_descriptor_size (tree desc, int rank)
5689	{
5690	return gfc_conv_descriptor_size_1 (desc, 0, rank);
5691	}
5692
5693
5694	/* Size of a coarray for all dimensions but the last. */
5695
5696	tree
5697	gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
5698	{
5699	return gfc_conv_descriptor_size_1 (desc, rank, rank + corank - 1);
5700	}
5701
5702
5703	/* Fills in an array descriptor, and returns the size of the array.
5704	The size will be a simple_val, ie a variable or a constant. Also
5705	calculates the offset of the base. The pointer argument overflow,
5706	which should be of integer type, will increase in value if overflow
5707	occurs during the size calculation. Returns the size of the array.
5708	{
5709	stride = 1;
5710	offset = 0;
5711	for (n = 0; n < rank; n++)
5712	{
5713	a.lbound[n] = specified_lower_bound;
5714	offset = offset + a.lbond[n] * stride;
5715	size = 1 - lbound;
5716	a.ubound[n] = specified_upper_bound;
5717	a.stride[n] = stride;
5718	size = size >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound
5719	overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0);
5720	stride = stride * size;
5721	}
5722	for (n = rank; n < rank+corank; n++)
5723	(Set lcobound/ucobound as above.)
5724	element_size = sizeof (array element);
5725	if (!rank)
5726	return element_size
5727	stride = (size_t) stride;
5728	overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0);
5729	stride = stride * element_size;
5730	return (stride);
5731	} */
5732	/GCC ARRAYS/
5733
5734	static tree
5735	gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
5736	gfc_expr lower, gfc_expr upper, stmtblock_t * pblock,
5737	stmtblock_t * descriptor_block, tree * overflow,
5738	tree expr3_elem_size, tree nelems, gfc_expr expr3,
5739	tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
5740	tree *element_size)
5741	{
5742	tree type;
5743	tree tmp;
5744	tree size;
5745	tree offset;
5746	tree stride;
5747	tree or_expr;
5748	tree thencase;
5749	tree elsecase;
5750	tree cond;
5751	tree var;
5752	stmtblock_t thenblock;
5753	stmtblock_t elseblock;
5754	gfc_expr *ubound;
5755	gfc_se se;
5756	int n;
5757
5758	type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5758, __FUNCTION__))->typed.type);
5759
5760	stride = gfc_index_one_nodegfc_rank_cst[1];
5761	offset = gfc_index_zero_nodegfc_rank_cst[0];
5762
5763	/* Set the dtype before the alloc, because registration of coarrays needs
5764	it initialized. */
5765	if (expr->ts.type == BT_CHARACTER
5766	&& expr->ts.deferred
5767	&& VAR_P (expr->ts.u.cl->backend_decl)(((enum tree_code) (expr->ts.u.cl->backend_decl)->base .code) == VAR_DECL))
5768	{
5769	type = gfc_typenode_for_spec (&expr->ts);
5770	tmp = gfc_conv_descriptor_dtype (descriptor);
5771	gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
5772	}
5773	else if (expr->ts.type == BT_CHARACTER
5774	&& expr->ts.deferred
5775	&& TREE_CODE (descriptor)((enum tree_code) (descriptor)->base.code) == COMPONENT_REF)
5776	{
5777	/* Deferred character components have their string length tucked away
5778	in a hidden field of the derived type. Obtain that and use it to
5779	set the dtype. The charlen backend decl is zero because the field
5780	type is zero length. */
5781	gfc_ref *ref;
5782	tmp = NULL_TREE(tree) __null;
5783	for (ref = expr->ref; ref; ref = ref->next)
5784	if (ref->type == REF_COMPONENT
5785	&& gfc_deferred_strlen (ref->u.c.component, &tmp))
5786	break;
5787	gcc_assert (tmp != NULL_TREE)((void)(!(tmp != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5787, __FUNCTION__), 0 : 0));
5788	tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5788, __FUNCTION__))->typed.type),
5789	TREE_OPERAND (descriptor, 0)(((const_cast<tree> (tree_operand_check ((descriptor) , (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5789, __FUNCTION__))))), tmp, NULL_TREE(tree) __null);
5790	tmp = fold_convert (gfc_charlen_type_node, tmp)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, tmp );
5791	type = gfc_get_character_type_len (expr->ts.kind, tmp);
5792	tmp = gfc_conv_descriptor_dtype (descriptor);
5793	gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
5794	}
5795	else
5796	{
5797	tmp = gfc_conv_descriptor_dtype (descriptor);
5798	gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
5799	}
5800
5801	or_expr = logical_false_node;
5802
5803	for (n = 0; n < rank; n++)
5804	{
5805	tree conv_lbound;
5806	tree conv_ubound;
5807
5808	/* We have 3 possibilities for determining the size of the array:
5809	lower == NULL => lbound = 1, ubound = upper[n]
5810	upper[n] = NULL => lbound = 1, ubound = lower[n]
5811	upper[n] != NULL => lbound = lower[n], ubound = upper[n] */
5812	ubound = upper[n];
5813
5814	/* Set lower bound. */
5815	gfc_init_se (&se, NULL__null);
5816	if (expr3_desc != NULL_TREE(tree) __null)
5817	{
5818	if (e3_has_nodescriptor)
5819	/* The lbound of nondescriptor arrays like array constructors,
5820	nonallocatable/nonpointer function results/variables,
5821	start at zero, but when allocating it, the standard expects
5822	the array to start at one. */
5823	se.expr = gfc_index_one_nodegfc_rank_cst[1];
5824	else
5825	se.expr = gfc_conv_descriptor_lbound_get (expr3_desc,
5826	gfc_rank_cst[n]);
5827	}
5828	else if (lower == NULL__null)
5829	se.expr = gfc_index_one_nodegfc_rank_cst[1];
5830	else
5831	{
5832	gcc_assert (lower[n])((void)(!(lower[n]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5832, __FUNCTION__), 0 : 0));
5833	if (ubound)
5834	{
5835	gfc_conv_expr_type (&se, lower[n], gfc_array_index_type);
5836	gfc_add_block_to_block (pblock, &se.pre);
5837	}
5838	else
5839	{
5840	se.expr = gfc_index_one_nodegfc_rank_cst[1];
5841	ubound = lower[n];
5842	}
5843	}
5844	gfc_conv_descriptor_lbound_set (descriptor_block, descriptor,
5845	gfc_rank_cst[n], se.expr);
5846	conv_lbound = se.expr;
5847
5848	/* Work out the offset for this component. */
5849	tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
5850	se.expr, stride);
5851	offset = fold_build2_loc (input_location, MINUS_EXPR,
5852	gfc_array_index_type, offset, tmp);
5853
5854	/* Set upper bound. */
5855	gfc_init_se (&se, NULL__null);
5856	if (expr3_desc != NULL_TREE(tree) __null)
5857	{
5858	if (e3_has_nodescriptor)
5859	{
5860	/* The lbound of nondescriptor arrays like array constructors,
5861	nonallocatable/nonpointer function results/variables,
5862	start at zero, but when allocating it, the standard expects
5863	the array to start at one. Therefore fix the upper bound to be
5864	(desc.ubound - desc.lbound) + 1. */
5865	tmp = fold_build2_loc (input_location, MINUS_EXPR,
5866	gfc_array_index_type,
5867	gfc_conv_descriptor_ubound_get (
5868	expr3_desc, gfc_rank_cst[n]),
5869	gfc_conv_descriptor_lbound_get (
5870	expr3_desc, gfc_rank_cst[n]));
5871	tmp = fold_build2_loc (input_location, PLUS_EXPR,
5872	gfc_array_index_type, tmp,
5873	gfc_index_one_nodegfc_rank_cst[1]);
5874	se.expr = gfc_evaluate_now (tmp, pblock);
5875	}
5876	else
5877	se.expr = gfc_conv_descriptor_ubound_get (expr3_desc,
5878	gfc_rank_cst[n]);
5879	}
5880	else
5881	{
5882	gcc_assert (ubound)((void)(!(ubound) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5882, __FUNCTION__), 0 : 0));
5883	gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
5884	gfc_add_block_to_block (pblock, &se.pre);
5885	if (ubound->expr_type == EXPR_FUNCTION)
5886	se.expr = gfc_evaluate_now (se.expr, pblock);
5887	}
5888	gfc_conv_descriptor_ubound_set (descriptor_block, descriptor,
5889	gfc_rank_cst[n], se.expr);
5890	conv_ubound = se.expr;
5891
5892	/* Store the stride. */
5893	gfc_conv_descriptor_stride_set (descriptor_block, descriptor,
5894	gfc_rank_cst[n], stride);
5895
5896	/* Calculate size and check whether extent is negative. */
5897	size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &or_expr);
5898	size = gfc_evaluate_now (size, pblock);
5899
5900	/* Check whether multiplying the stride by the number of
5901	elements in this dimension would overflow. We must also check
5902	whether the current dimension has zero size in order to avoid
5903	division by zero.
5904	*/
5905	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
5906	gfc_array_index_type,
5907	fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_check5 ((gfc_array_index_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5908, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval ))
5908	TYPE_MAX_VALUE (gfc_array_index_type))fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_check5 ((gfc_array_index_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.cc" , 5908, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval )),
5909	size);
5910	cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
5911	logical_type_node, tmp, stride),
5912	PRED_FORTRAN_OVERFLOW);
5913	tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_nodeinteger_types[itk_int], cond,
5914	integer_one_nodeglobal_trees[TI_INTEGER_ONE], integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
5915	cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
5916	logical_type_node, size,
5917	gfc_index_zero_nodegfc_rank_cst[0]),
5918	PRED_FORTRAN_SIZE_ZERO);
5919	tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_nodeinteger_types[itk_int], cond,
5920	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO], tmp);
5921	tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_nodeinteger_types[itk_int],
5922	*overflow, tmp);
5923	*overflow = gfc_evaluate_now (tmp, pblock);
5924
5925	/* Multiply the stride by the number of elements in this dimension. */
5926	stride = fold_build2_loc (input_location, MULT_EXPR,
5927	gfc_array_index_type, stride, size);
5928	stride = gfc_evaluate_now (stride, pblock);