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

Bug Summary

File:	build/gcc/fortran/trans-expr.cc
Warning:	line 10086, column 3 Value stored to 'expr1_vptr' is never read

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-expr.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-aZrI2e.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc

1	/* Expression translation
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-expr.cc-- generate GENERIC trees for gfc_expr. */
23
24	#include "config.h"
25	#include "system.h"
26	#include "coretypes.h"
27	#include "options.h"
28	#include "tree.h"
29	#include "gfortran.h"
30	#include "trans.h"
31	#include "stringpool.h"
32	#include "diagnostic-core.h" /* For fatal_error. */
33	#include "fold-const.h"
34	#include "langhooks.h"
35	#include "arith.h"
36	#include "constructor.h"
37	#include "trans-const.h"
38	#include "trans-types.h"
39	#include "trans-array.h"
40	/* Only for gfc_trans_assign and gfc_trans_pointer_assign. */
41	#include "trans-stmt.h"
42	#include "dependency.h"
43	#include "gimplify.h"
44	#include "tm.h" /* For CHAR_TYPE_SIZE. */
45
46
47	/* Calculate the number of characters in a string. */
48
49	static tree
50	gfc_get_character_len (tree type)
51	{
52	tree len;
53
54	gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE((void)(!(type && ((enum tree_code) (type)->base.code ) == ARRAY_TYPE && ((tree_check2 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 55, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common .string_flag)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 55, __FUNCTION__), 0 : 0))
55	&& TYPE_STRING_FLAG (type))((void)(!(type && ((enum tree_code) (type)->base.code ) == ARRAY_TYPE && ((tree_check2 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 55, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common .string_flag)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 55, __FUNCTION__), 0 : 0));
56
57	len = TYPE_MAX_VALUE (TYPE_DOMAIN (type))((tree_check5 ((((tree_check ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 57, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values )), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 57, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval );
58	len = (len) ? (len) : (integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
59	return fold_convert (gfc_charlen_type_node, len)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, len );
60	}
61
62
63
64	/* Calculate the number of bytes in a string. */
65
66	tree
67	gfc_get_character_len_in_bytes (tree type)
68	{
69	tree tmp, len;
70
71	gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE((void)(!(type && ((enum tree_code) (type)->base.code ) == ARRAY_TYPE && ((tree_check2 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 72, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common .string_flag)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 72, __FUNCTION__), 0 : 0))
72	&& TYPE_STRING_FLAG (type))((void)(!(type && ((enum tree_code) (type)->base.code ) == ARRAY_TYPE && ((tree_check2 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 72, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common .string_flag)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 72, __FUNCTION__), 0 : 0));
73
74	tmp = TYPE_SIZE_UNIT (TREE_TYPE (type))((tree_class_check ((((contains_struct_check ((type), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 74, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 74, __FUNCTION__))->type_common.size_unit);
75	tmp = (tmp && !integer_zerop (tmp))
76	? (fold_convert (gfc_charlen_type_node, tmp)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, tmp )) : (NULL_TREE(tree) __null);
77	len = gfc_get_character_len (type);
78	if (tmp && len && !integer_zerop (len))
79	len = fold_build2_loc (input_location, MULT_EXPR,
80	gfc_charlen_type_node, len, tmp);
81	return len;
82	}
83
84
85	/* Convert a scalar to an array descriptor. To be used for assumed-rank
86	arrays. */
87
88	static tree
89	get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
90	{
91	enum gfc_array_kind akind;
92
93	if (attr.pointer)
94	akind = GFC_ARRAY_POINTER_CONT;
95	else if (attr.allocatable)
96	akind = GFC_ARRAY_ALLOCATABLE;
97	else
98	akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
99
100	if (POINTER_TYPE_P (TREE_TYPE (scalar))(((enum tree_code) (((contains_struct_check ((scalar), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 100, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((scalar), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 100, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
101	scalar = TREE_TYPE (scalar)((contains_struct_check ((scalar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 101, __FUNCTION__))->typed.type);
102	return gfc_get_array_type_bounds (TREE_TYPE (scalar)((contains_struct_check ((scalar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 102, __FUNCTION__))->typed.type), 0, 0, NULL__null, NULL__null, 1,
103	akind, !(attr.pointer \|\| attr.target));
104	}
105
106	tree
107	gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
108	{
109	tree desc, type, etype;
110
111	type = get_scalar_to_descriptor_type (scalar, attr);
112	etype = TREE_TYPE (scalar)((contains_struct_check ((scalar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 112, __FUNCTION__))->typed.type);
113	desc = gfc_create_var (type, "desc");
114	DECL_ARTIFICIAL (desc)((contains_struct_check ((desc), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 114, __FUNCTION__))->decl_common.artificial_flag) = 1;
115
116	if (CONSTANT_CLASS_P (scalar)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (scalar)->base.code))] == tcc_constant))
117	{
118	tree tmp;
119	tmp = gfc_create_var (TREE_TYPE (scalar)((contains_struct_check ((scalar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 119, __FUNCTION__))->typed.type), "scalar");
120	gfc_add_modify (&se->pre, tmp, scalar);
121	scalar = tmp;
122	}
123	if (!POINTER_TYPE_P (TREE_TYPE (scalar))(((enum tree_code) (((contains_struct_check ((scalar), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 123, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((scalar), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 123, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
124	scalar = gfc_build_addr_expr (NULL_TREE(tree) __null, scalar);
125	else if (TREE_TYPE (etype)((contains_struct_check ((etype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 125, __FUNCTION__))->typed.type) && TREE_CODE (TREE_TYPE (etype))((enum tree_code) (((contains_struct_check ((etype), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 125, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE)
126	etype = TREE_TYPE (etype)((contains_struct_check ((etype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 126, __FUNCTION__))->typed.type);
127	gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
128	gfc_get_dtype_rank_type (0, etype));
129	gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
130	gfc_conv_descriptor_span_set (&se->pre, desc,
131	gfc_conv_descriptor_elem_len (desc));
132
133	/* Copy pointer address back - but only if it could have changed and
134	if the actual argument is a pointer and not, e.g., NULL(). */
135	if ((attr.pointer \|\| attr.allocatable) && attr.intent != INTENT_IN)
136	gfc_add_modify (&se->post, scalar,
137	fold_convert (TREE_TYPE (scalar),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (scalar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 137, __FUNCTION__))->typed.type), gfc_conv_descriptor_data_get (desc))
138	gfc_conv_descriptor_data_get (desc))fold_convert_loc (((location_t) 0), ((contains_struct_check ( (scalar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 137, __FUNCTION__))->typed.type), gfc_conv_descriptor_data_get (desc)));
139	return desc;
140	}
141
142
143	/* Get the coarray token from the ultimate array or component ref.
144	Returns a NULL_TREE, when the ref object is not allocatable or pointer. */
145
146	tree
147	gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se outerse, gfc_expr expr)
148	{
149	gfc_symbol *sym = expr->symtree->n.sym;
150	bool is_coarray = sym->attr.codimension;
151	gfc_expr *caf_expr = gfc_copy_expr (expr);
152	gfc_ref ref = caf_expr->ref, last_caf_ref = NULL__null;
153
154	while (ref)
155	{
156	if (ref->type == REF_COMPONENT
157	&& (ref->u.c.component->attr.allocatable
158	\|\| ref->u.c.component->attr.pointer)
159	&& (is_coarray \|\| ref->u.c.component->attr.codimension))
160	last_caf_ref = ref;
161	ref = ref->next;
162	}
163
164	if (last_caf_ref == NULL__null)
165	return NULL_TREE(tree) __null;
166
167	tree comp = last_caf_ref->u.c.component->caf_token, caf;
168	gfc_se se;
169	bool comp_ref = !last_caf_ref->u.c.component->attr.dimension;
170	if (comp == NULL_TREE(tree) __null && comp_ref)
171	return NULL_TREE(tree) __null;
172	gfc_init_se (&se, outerse);
173	gfc_free_ref_list (last_caf_ref->next);
174	last_caf_ref->next = NULL__null;
175	caf_expr->rank = comp_ref ? 0 : last_caf_ref->u.c.component->as->rank;
176	se.want_pointer = comp_ref;
177	gfc_conv_expr (&se, caf_expr);
178	gfc_add_block_to_block (&outerse->pre, &se.pre);
179
180	if (TREE_CODE (se.expr)((enum tree_code) (se.expr)->base.code) == COMPONENT_REF && comp_ref)
181	se.expr = TREE_OPERAND (se.expr, 0)(((const_cast<tree> (tree_operand_check ((se.expr), ( 0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 181, __FUNCTION__)))));
182	gfc_free_expr (caf_expr);
183
184	if (comp_ref)
185	caf = fold_build3_loc (input_location, COMPONENT_REF,
186	TREE_TYPE (comp)((contains_struct_check ((comp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 186, __FUNCTION__))->typed.type), se.expr, comp, NULL_TREE(tree) __null);
187	else
188	caf = gfc_conv_descriptor_token (se.expr);
189	return gfc_build_addr_expr (NULL_TREE(tree) __null, caf);
190	}
191
192
193	/* This is the seed for an eventual trans-class.c
194
195	The following parameters should not be used directly since they might
196	in future implementations. Use the corresponding APIs. */
197	#define CLASS_DATA_FIELD 0
198	#define CLASS_VPTR_FIELD 1
199	#define CLASS_LEN_FIELD 2
200	#define VTABLE_HASH_FIELD 0
201	#define VTABLE_SIZE_FIELD 1
202	#define VTABLE_EXTENDS_FIELD 2
203	#define VTABLE_DEF_INIT_FIELD 3
204	#define VTABLE_COPY_FIELD 4
205	#define VTABLE_FINAL_FIELD 5
206	#define VTABLE_DEALLOCATE_FIELD6 6
207
208
209	tree
210	gfc_class_set_static_fields (tree decl, tree vptr, tree data)
211	{
212	tree tmp;
213	tree field;
214	vec<constructor_elt, va_gc> *init = NULL__null;
215
216	field = TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 216, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 216, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values);
217	tmp = gfc_advance_chain (field, CLASS_DATA_FIELD);
218	CONSTRUCTOR_APPEND_ELT (init, tmp, data)do { constructor_elt _ce___ = {tmp, data}; vec_safe_push ((init ), _ce___); } while (0);
219
220	tmp = gfc_advance_chain (field, CLASS_VPTR_FIELD);
221	CONSTRUCTOR_APPEND_ELT (init, tmp, vptr)do { constructor_elt _ce___ = {tmp, vptr}; vec_safe_push ((init ), _ce___); } while (0);
222
223	return build_constructor (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 223, __FUNCTION__))->typed.type), init);
224	}
225
226
227	tree
228	gfc_class_data_get (tree decl)
229	{
230	tree data;
231	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-expr.cc" , 231, __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-expr.cc" , 231, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
232	decl = build_fold_indirect_ref_loc (input_location, decl);
233	data = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 233, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 233, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values),
234	CLASS_DATA_FIELD);
235	return fold_build3_loc (input_location, COMPONENT_REF,
236	TREE_TYPE (data)((contains_struct_check ((data), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 236, __FUNCTION__))->typed.type), decl, data,
237	NULL_TREE(tree) __null);
238	}
239
240
241	tree
242	gfc_class_vptr_get (tree decl)
243	{
244	tree vptr;
245	/* For class arrays decl may be a temporary descriptor handle, the vptr is
246	then available through the saved descriptor. */
247	if (VAR_P (decl)(((enum tree_code) (decl)->base.code) == VAR_DECL) && DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 247, __FUNCTION__))->decl_common.lang_specific)
248	&& GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 248, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
249	decl = GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 249, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
250	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-expr.cc" , 250, __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-expr.cc" , 250, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
251	decl = build_fold_indirect_ref_loc (input_location, decl);
252	vptr = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 252, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 252, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values),
253	CLASS_VPTR_FIELD);
254	return fold_build3_loc (input_location, COMPONENT_REF,
255	TREE_TYPE (vptr)((contains_struct_check ((vptr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 255, __FUNCTION__))->typed.type), decl, vptr,
256	NULL_TREE(tree) __null);
257	}
258
259
260	tree
261	gfc_class_len_get (tree decl)
262	{
263	tree len;
264	/* For class arrays decl may be a temporary descriptor handle, the len is
265	then available through the saved descriptor. */
266	if (VAR_P (decl)(((enum tree_code) (decl)->base.code) == VAR_DECL) && DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 266, __FUNCTION__))->decl_common.lang_specific)
267	&& GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 267, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
268	decl = GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 268, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
269	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-expr.cc" , 269, __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-expr.cc" , 269, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
270	decl = build_fold_indirect_ref_loc (input_location, decl);
271	len = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 271, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 271, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values),
272	CLASS_LEN_FIELD);
273	return fold_build3_loc (input_location, COMPONENT_REF,
274	TREE_TYPE (len)((contains_struct_check ((len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 274, __FUNCTION__))->typed.type), decl, len,
275	NULL_TREE(tree) __null);
276	}
277
278
279	/* Try to get the _len component of a class. When the class is not unlimited
280	poly, i.e. no _len field exists, then return a zero node. */
281
282	static tree
283	gfc_class_len_or_zero_get (tree decl)
284	{
285	tree len;
286	/* For class arrays decl may be a temporary descriptor handle, the vptr is
287	then available through the saved descriptor. */
288	if (VAR_P (decl)(((enum tree_code) (decl)->base.code) == VAR_DECL) && DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 288, __FUNCTION__))->decl_common.lang_specific)
289	&& GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 289, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
290	decl = GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 290, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
291	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-expr.cc" , 291, __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-expr.cc" , 291, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
292	decl = build_fold_indirect_ref_loc (input_location, decl);
293	len = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 293, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 293, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values),
294	CLASS_LEN_FIELD);
295	return len != NULL_TREE(tree) __null ? fold_build3_loc (input_location, COMPONENT_REF,
296	TREE_TYPE (len)((contains_struct_check ((len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 296, __FUNCTION__))->typed.type), decl, len,
297	NULL_TREE(tree) __null)
298	: build_zero_cst (gfc_charlen_type_node);
299	}
300
301
302	tree
303	gfc_resize_class_size_with_len (stmtblock_t * block, tree class_expr, tree size)
304	{
305	tree tmp;
306	tree tmp2;
307	tree type;
308
309	tmp = gfc_class_len_or_zero_get (class_expr);
310
311	/* Include the len value in the element size if present. */
312	if (!integer_zerop (tmp))
313	{
314	type = TREE_TYPE (size)((contains_struct_check ((size), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 314, __FUNCTION__))->typed.type);
315	if (block)
316	{
317	size = gfc_evaluate_now (size, block);
318	tmp = gfc_evaluate_now (fold_convert (type , tmp)fold_convert_loc (((location_t) 0), type, tmp), block);
319	}
320	tmp2 = fold_build2_loc (input_location, MULT_EXPR,
321	type, size, tmp);
322	tmp = fold_build2_loc (input_location, GT_EXPR,
323	logical_type_node, tmp,
324	build_zero_cst (type));
325	size = fold_build3_loc (input_location, COND_EXPR,
326	type, tmp, tmp2, size);
327	}
328	else
329	return size;
330
331	if (block)
332	size = gfc_evaluate_now (size, block);
333
334	return size;
335	}
336
337
338	/* Get the specified FIELD from the VPTR. */
339
340	static tree
341	vptr_field_get (tree vptr, int fieldno)
342	{
343	tree field;
344	vptr = build_fold_indirect_ref_loc (input_location, vptr);
345	field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (vptr))((tree_check3 ((((contains_struct_check ((vptr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 345, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 345, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values),
346	fieldno);
347	field = fold_build3_loc (input_location, COMPONENT_REF,
348	TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 348, __FUNCTION__))->typed.type), vptr, field,
349	NULL_TREE(tree) __null);
350	gcc_assert (field)((void)(!(field) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 350, __FUNCTION__), 0 : 0));
351	return field;
352	}
353
354
355	/* Get the field from the class' vptr. */
356
357	static tree
358	class_vtab_field_get (tree decl, int fieldno)
359	{
360	tree vptr;
361	vptr = gfc_class_vptr_get (decl);
362	return vptr_field_get (vptr, fieldno);
363	}
364
365
366	/* Define a macro for creating the class_vtab_* and vptr_* accessors in
367	unison. */
368	#define VTAB_GET_FIELD_GEN(name, field) tree \
369	gfc_class_vtab_## name ##_get (tree cl) \
370	{ \
371	return class_vtab_field_get (cl, field); \
372	} \
373	\
374	tree \
375	gfc_vptr_## name ##_get (tree vptr) \
376	{ \
377	return vptr_field_get (vptr, field); \
378	}
379
380	VTAB_GET_FIELD_GEN (hash, VTABLE_HASH_FIELD)
381	VTAB_GET_FIELD_GEN (extends, VTABLE_EXTENDS_FIELD)
382	VTAB_GET_FIELD_GEN (def_init, VTABLE_DEF_INIT_FIELD)
383	VTAB_GET_FIELD_GEN (copy, VTABLE_COPY_FIELD)
384	VTAB_GET_FIELD_GEN (final, VTABLE_FINAL_FIELD)
385	VTAB_GET_FIELD_GEN (deallocate, VTABLE_DEALLOCATE_FIELD6)
386	#undef VTAB_GET_FIELD_GEN
387
388	/* The size field is returned as an array index type. Therefore treat
389	it and only it specially. */
390
391	tree
392	gfc_class_vtab_size_get (tree cl)
393	{
394	tree size;
395	size = class_vtab_field_get (cl, VTABLE_SIZE_FIELD);
396	/* Always return size as an array index type. */
397	size = fold_convert (gfc_array_index_type, size)fold_convert_loc (((location_t) 0), gfc_array_index_type, size );
398	gcc_assert (size)((void)(!(size) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 398, __FUNCTION__), 0 : 0));
399	return size;
400	}
401
402	tree
403	gfc_vptr_size_get (tree vptr)
404	{
405	tree size;
406	size = vptr_field_get (vptr, VTABLE_SIZE_FIELD);
407	/* Always return size as an array index type. */
408	size = fold_convert (gfc_array_index_type, size)fold_convert_loc (((location_t) 0), gfc_array_index_type, size );
409	gcc_assert (size)((void)(!(size) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 409, __FUNCTION__), 0 : 0));
410	return size;
411	}
412
413
414	#undef CLASS_DATA_FIELD
415	#undef CLASS_VPTR_FIELD
416	#undef CLASS_LEN_FIELD
417	#undef VTABLE_HASH_FIELD
418	#undef VTABLE_SIZE_FIELD
419	#undef VTABLE_EXTENDS_FIELD
420	#undef VTABLE_DEF_INIT_FIELD
421	#undef VTABLE_COPY_FIELD
422	#undef VTABLE_FINAL_FIELD
423
424
425	/* IF ts is null (default), search for the last _class ref in the chain
426	of references of the expression and cut the chain there. Although
427	this routine is similiar to class.cc:gfc_add_component_ref (), there
428	is a significant difference: gfc_add_component_ref () concentrates
429	on an array ref that is the last ref in the chain and is oblivious
430	to the kind of refs following.
431	ELSE IF ts is non-null the cut is at the class entity or component
432	that is followed by an array reference, which is not an element.
433	These calls come from trans-array.cc:build_class_array_ref, which
434	handles scalarized class array references.*/
435
436	gfc_expr *
437	gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold,
438	gfc_typespec **ts)
439	{
440	gfc_expr *base_expr;
441	gfc_ref ref, class_ref, tail = NULL__null, array_ref;
442
443	/* Find the last class reference. */
444	class_ref = NULL__null;
445	array_ref = NULL__null;
446
447	if (ts)
448	{
449	if (e->symtree
450	&& e->symtree->n.sym->ts.type == BT_CLASS)
451	*ts = &e->symtree->n.sym->ts;
452	else
453	*ts = NULL__null;
454	}
455
456	for (ref = e->ref; ref; ref = ref->next)
457	{
458	if (ts)
459	{
460	if (ref->type == REF_COMPONENT
461	&& ref->u.c.component->ts.type == BT_CLASS
462	&& ref->next && ref->next->type == REF_COMPONENT
463	&& !strcmp (ref->next->u.c.component->name, "_data")
464	&& ref->next->next
465	&& ref->next->next->type == REF_ARRAY
466	&& ref->next->next->u.ar.type != AR_ELEMENT)
467	{
468	*ts = &ref->u.c.component->ts;
469	class_ref = ref;
470	break;
471	}
472
473	if (ref->next == NULL__null)
474	break;
475	}
476	else
477	{
478	if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
479	array_ref = ref;
480
481	if (ref->type == REF_COMPONENT
482	&& ref->u.c.component->ts.type == BT_CLASS)
483	{
484	/* Component to the right of a part reference with nonzero
485	rank must not have the ALLOCATABLE attribute. If attempts
486	are made to reference such a component reference, an error
487	results followed by an ICE. */
488	if (array_ref
489	&& CLASS_DATA (ref->u.c.component)ref->u.c.component->ts.u.derived->components->attr.allocatable)
490	return NULL__null;
491	class_ref = ref;
492	}
493	}
494	}
495
496	if (ts && *ts == NULL__null)
497	return NULL__null;
498
499	/* Remove and store all subsequent references after the
500	CLASS reference. */
501	if (class_ref)
502	{
503	tail = class_ref->next;
504	class_ref->next = NULL__null;
505	}
506	else if (e->symtree && e->symtree->n.sym->ts.type == BT_CLASS)
507	{
508	tail = e->ref;
509	e->ref = NULL__null;
510	}
511
512	if (is_mold)
513	base_expr = gfc_expr_to_initialize (e);
514	else
515	base_expr = gfc_copy_expr (e);
516
517	/* Restore the original tail expression. */
518	if (class_ref)
519	{
520	gfc_free_ref_list (class_ref->next);
521	class_ref->next = tail;
522	}
523	else if (e->symtree && e->symtree->n.sym->ts.type == BT_CLASS)
524	{
525	gfc_free_ref_list (e->ref);
526	e->ref = tail;
527	}
528	return base_expr;
529	}
530
531
532	/* Reset the vptr to the declared type, e.g. after deallocation. */
533
534	void
535	gfc_reset_vptr (stmtblock_t block, gfc_expr e)
536	{
537	gfc_symbol *vtab;
538	tree vptr;
539	tree vtable;
540	gfc_se se;
541
542	/* Evaluate the expression and obtain the vptr from it. */
543	gfc_init_se (&se, NULL__null);
544	if (e->rank)
545	gfc_conv_expr_descriptor (&se, e);
546	else
547	gfc_conv_expr (&se, e);
548	gfc_add_block_to_block (block, &se.pre);
549	vptr = gfc_get_vptr_from_expr (se.expr);
550
551	/* If a vptr is not found, we can do nothing more. */
552	if (vptr == NULL_TREE(tree) __null)
553	return;
554
555	if (UNLIMITED_POLY (e)(e != __null && e->ts.type == BT_CLASS && e ->ts.u.derived->components && e->ts.u.derived ->components->ts.u.derived && e->ts.u.derived ->components->ts.u.derived->attr.unlimited_polymorphic ))
556	gfc_add_modify (block, vptr, build_int_cst (TREE_TYPE (vptr)((contains_struct_check ((vptr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 556, __FUNCTION__))->typed.type), 0));
557	else
558	{
559	/* Return the vptr to the address of the declared type. */
560	vtab = gfc_find_derived_vtab (e->ts.u.derived);
561	vtable = vtab->backend_decl;
562	if (vtable == NULL_TREE(tree) __null)
563	vtable = gfc_get_symbol_decl (vtab);
564	vtable = gfc_build_addr_expr (NULL__null, vtable);
565	vtable = fold_convert (TREE_TYPE (vptr), vtable)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (vptr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 565, __FUNCTION__))->typed.type), vtable);
566	gfc_add_modify (block, vptr, vtable);
567	}
568	}
569
570
571	/* Reset the len for unlimited polymorphic objects. */
572
573	void
574	gfc_reset_len (stmtblock_t block, gfc_expr expr)
575	{
576	gfc_expr *e;
577	gfc_se se_len;
578	e = gfc_find_and_cut_at_last_class_ref (expr);
579	if (e == NULL__null)
580	return;
581	gfc_add_len_component (e)gfc_add_component_ref(e,"_len");
582	gfc_init_se (&se_len, NULL__null);
583	gfc_conv_expr (&se_len, e);
584	gfc_add_modify (block, se_len.expr,
585	fold_convert (TREE_TYPE (se_len.expr), integer_zero_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (se_len.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 585, __FUNCTION__))->typed.type), global_trees[TI_INTEGER_ZERO ]));
586	gfc_free_expr (e);
587	}
588
589
590	/* Obtain the last class reference in a gfc_expr. Return NULL_TREE if no class
591	reference is found. Note that it is up to the caller to avoid using this
592	for expressions other than variables. */
593
594	tree
595	gfc_get_class_from_gfc_expr (gfc_expr *e)
596	{
597	gfc_expr *class_expr;
598	gfc_se cse;
599	class_expr = gfc_find_and_cut_at_last_class_ref (e);
600	if (class_expr == NULL__null)
601	return NULL_TREE(tree) __null;
602	gfc_init_se (&cse, NULL__null);
603	gfc_conv_expr (&cse, class_expr);
604	gfc_free_expr (class_expr);
605	return cse.expr;
606	}
607
608
609	/* Obtain the last class reference in an expression.
610	Return NULL_TREE if no class reference is found. */
611
612	tree
613	gfc_get_class_from_expr (tree expr)
614	{
615	tree tmp;
616	tree type;
617
618	for (tmp = expr; tmp; tmp = TREE_OPERAND (tmp, 0)(((const_cast<tree> (tree_operand_check ((tmp), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 618, __FUNCTION__))))))
619	{
620	if (CONSTANT_CLASS_P (tmp)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (tmp)->base.code))] == tcc_constant))
621	return NULL_TREE(tree) __null;
622
623	type = TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 623, __FUNCTION__))->typed.type);
624	while (type)
625	{
626	if (GFC_CLASS_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 626, __FUNCTION__))->type_common.lang_flag_4))
627	return tmp;
628	if (type != TYPE_CANONICAL (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 628, __FUNCTION__))->type_common.canonical))
629	type = TYPE_CANONICAL (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 629, __FUNCTION__))->type_common.canonical);
630	else
631	type = NULL_TREE(tree) __null;
632	}
633	if (VAR_P (tmp)(((enum tree_code) (tmp)->base.code) == VAR_DECL) \|\| TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == PARM_DECL)
634	break;
635	}
636
637	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-expr.cc" , 637, __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-expr.cc" , 637, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
638	tmp = build_fold_indirect_ref_loc (input_location, tmp);
639
640	if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))((tree_class_check ((((contains_struct_check ((tmp), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 640, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 640, __FUNCTION__))->type_common.lang_flag_4))
641	return tmp;
642
643	return NULL_TREE(tree) __null;
644	}
645
646
647	/* Obtain the vptr of the last class reference in an expression.
648	Return NULL_TREE if no class reference is found. */
649
650	tree
651	gfc_get_vptr_from_expr (tree expr)
652	{
653	tree tmp;
654
655	tmp = gfc_get_class_from_expr (expr);
656
657	if (tmp != NULL_TREE(tree) __null)
658	return gfc_class_vptr_get (tmp);
659
660	return NULL_TREE(tree) __null;
661	}
662
663
664	static void
665	class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
666	bool lhs_type)
667	{
668	tree tmp, tmp2, type;
669
670	gfc_conv_descriptor_data_set (block, lhs_desc,
671	gfc_conv_descriptor_data_get (rhs_desc));
672	gfc_conv_descriptor_offset_set (block, lhs_desc,
673	gfc_conv_descriptor_offset_get (rhs_desc));
674
675	gfc_add_modify (block, gfc_conv_descriptor_dtype (lhs_desc),
676	gfc_conv_descriptor_dtype (rhs_desc));
677
678	/* Assign the dimension as range-ref. */
679	tmp = gfc_get_descriptor_dimension (lhs_desc);
680	tmp2 = gfc_get_descriptor_dimension (rhs_desc);
681
682	type = lhs_type ? TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 682, __FUNCTION__))->typed.type) : TREE_TYPE (tmp2)((contains_struct_check ((tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 682, __FUNCTION__))->typed.type);
683	tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
684	gfc_index_zero_nodegfc_rank_cst[0], NULL_TREE(tree) __null, NULL_TREE(tree) __null);
685	tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2,
686	gfc_index_zero_nodegfc_rank_cst[0], NULL_TREE(tree) __null, NULL_TREE(tree) __null);
687	gfc_add_modify (block, tmp, tmp2);
688	}
689
690
691	/* Takes a derived type expression and returns the address of a temporary
692	class object of the 'declared' type. If vptr is not NULL, this is
693	used for the temporary class object.
694	optional_alloc_ptr is false when the dummy is neither allocatable
695	nor a pointer; that's only relevant for the optional handling.
696	The optional argument 'derived_array' is used to preserve the parmse
697	expression for deallocation of allocatable components. Assumed rank
698	formal arguments made this necessary. */
699	void
700	gfc_conv_derived_to_class (gfc_se parmse, gfc_expr e,
701	gfc_typespec class_ts, tree vptr, bool optional,
702	bool optional_alloc_ptr,
703	tree *derived_array)
704	{
705	gfc_symbol *vtab;
706	tree cond_optional = NULL_TREE(tree) __null;
707	gfc_ss *ss;
708	tree ctree;
709	tree var;
710	tree tmp;
711	int dim;
712
713	/* The derived type needs to be converted to a temporary
714	CLASS object. */
715	tmp = gfc_typenode_for_spec (&class_ts);
716	var = gfc_create_var (tmp, "class");
717
718	/* Set the vptr. */
719	ctree = gfc_class_vptr_get (var);
720
721	if (vptr != NULL_TREE(tree) __null)
722	{
723	/* Use the dynamic vptr. */
724	tmp = vptr;
725	}
726	else
727	{
728	/* In this case the vtab corresponds to the derived type and the
729	vptr must point to it. */
730	vtab = gfc_find_derived_vtab (e->ts.u.derived);
731	gcc_assert (vtab)((void)(!(vtab) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 731, __FUNCTION__), 0 : 0));
732	tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, gfc_get_symbol_decl (vtab));
733	}
734	gfc_add_modify (&parmse->pre, ctree,
735	fold_convert (TREE_TYPE (ctree), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 735, __FUNCTION__))->typed.type), tmp));
736
737	/* Now set the data field. */
738	ctree = gfc_class_data_get (var);
739
740	if (optional)
741	cond_optional = gfc_conv_expr_present (e->symtree->n.sym);
742
743	if (parmse->expr && POINTER_TYPE_P (TREE_TYPE (parmse->expr))(((enum tree_code) (((contains_struct_check ((parmse->expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 743, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((parmse->expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 743, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
744	{
745	/* If there is a ready made pointer to a derived type, use it
746	rather than evaluating the expression again. */
747	tmp = fold_convert (TREE_TYPE (ctree), parmse->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 747, __FUNCTION__))->typed.type), parmse->expr);
748	gfc_add_modify (&parmse->pre, ctree, tmp);
749	}
750	else if (parmse->ss && parmse->ss->info && parmse->ss->info->useflags)
751	{
752	/* For an array reference in an elemental procedure call we need
753	to retain the ss to provide the scalarized array reference. */
754	gfc_conv_expr_reference (parmse, e);
755	tmp = fold_convert (TREE_TYPE (ctree), parmse->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 755, __FUNCTION__))->typed.type), parmse->expr);
756	if (optional)
757	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 757, __FUNCTION__))->typed.type),
758	cond_optional, tmp,
759	fold_convert (TREE_TYPE (tmp), null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 759, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
760	gfc_add_modify (&parmse->pre, ctree, tmp);
761	}
762	else
763	{
764	ss = gfc_walk_expr (e);
765	if (ss == gfc_ss_terminator)
766	{
767	parmse->ss = NULL__null;
768	gfc_conv_expr_reference (parmse, e);
769
770	/* Scalar to an assumed-rank array. */
771	if (class_ts.u.derived->components->as)
772	{
773	tree type;
774	type = get_scalar_to_descriptor_type (parmse->expr,
775	gfc_expr_attr (e));
776	gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
777	gfc_get_dtype (type));
778	if (optional)
779	parmse->expr = build3_loc (input_location, COND_EXPR,
780	TREE_TYPE (parmse->expr)((contains_struct_check ((parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 780, __FUNCTION__))->typed.type),
781	cond_optional, parmse->expr,
782	fold_convert (TREE_TYPE (parmse->expr),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 782, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
783	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 782, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
784	gfc_conv_descriptor_data_set (&parmse->pre, ctree, parmse->expr);
785	}
786	else
787	{
788	tmp = fold_convert (TREE_TYPE (ctree), parmse->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 788, __FUNCTION__))->typed.type), parmse->expr);
789	if (optional)
790	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 790, __FUNCTION__))->typed.type),
791	cond_optional, tmp,
792	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-expr.cc" , 792, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
793	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 792, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
794	gfc_add_modify (&parmse->pre, ctree, tmp);
795	}
796	}
797	else
798	{
799	stmtblock_t block;
800	gfc_init_block (&block);
801	gfc_ref *ref;
802
803	parmse->ss = ss;
804	parmse->use_offset = 1;
805	gfc_conv_expr_descriptor (parmse, e);
806
807	/* Detect any array references with vector subscripts. */
808	for (ref = e->ref; ref; ref = ref->next)
809	if (ref->type == REF_ARRAY
810	&& ref->u.ar.type != AR_ELEMENT
811	&& ref->u.ar.type != AR_FULL)
812	{
813	for (dim = 0; dim < ref->u.ar.dimen; dim++)
814	if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
815	break;
816	if (dim < ref->u.ar.dimen)
817	break;
818	}
819
820	/* Array references with vector subscripts and non-variable expressions
821	need be converted to a one-based descriptor. */
822	if (ref \|\| e->expr_type != EXPR_VARIABLE)
823	{
824	for (dim = 0; dim < e->rank; ++dim)
825	gfc_conv_shift_descriptor_lbound (&block, parmse->expr, dim,
826	gfc_index_one_nodegfc_rank_cst[1]);
827	}
828
829	if (e->rank != class_ts.u.derived->components->as->rank)
830	{
831	gcc_assert (class_ts.u.derived->components->as->type((void)(!(class_ts.u.derived->components->as->type == AS_ASSUMED_RANK) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 832, __FUNCTION__), 0 : 0))
832	== AS_ASSUMED_RANK)((void)(!(class_ts.u.derived->components->as->type == AS_ASSUMED_RANK) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 832, __FUNCTION__), 0 : 0));
833	if (derived_array
834	&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr))((tree_class_check ((((contains_struct_check ((parmse->expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 834, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 834, __FUNCTION__))->type_common.lang_flag_1))
835	{
836	*derived_array = gfc_create_var (TREE_TYPE (parmse->expr)((contains_struct_check ((parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 836, __FUNCTION__))->typed.type),
837	"array");
838	gfc_add_modify (&block, *derived_array , parmse->expr);
839	}
840	class_array_data_assign (&block, ctree, parmse->expr, false);
841	}
842	else
843	{
844	if (gfc_expr_attr (e).codimension)
845	parmse->expr = fold_build1_loc (input_location,
846	VIEW_CONVERT_EXPR,
847	TREE_TYPE (ctree)((contains_struct_check ((ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 847, __FUNCTION__))->typed.type),
848	parmse->expr);
849	gfc_add_modify (&block, ctree, parmse->expr);
850	}
851
852	if (optional)
853	{
854	tmp = gfc_finish_block (&block);
855
856	gfc_init_block (&block);
857	gfc_conv_descriptor_data_set (&block, ctree, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
858	if (derived_array && *derived_array != NULL_TREE(tree) __null)
859	gfc_conv_descriptor_data_set (&block, *derived_array,
860	null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
861
862	tmp = build3_v (COND_EXPR, cond_optional, tmp,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond_optional, tmp, gfc_finish_block (&block))
863	gfc_finish_block (&block))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond_optional, tmp, gfc_finish_block (&block));
864	gfc_add_expr_to_block (&parmse->pre, tmp);
865	}
866	else
867	gfc_add_block_to_block (&parmse->pre, &block);
868	}
869	}
870
871	if (class_ts.u.derived->components->ts.type == BT_DERIVED
872	&& class_ts.u.derived->components->ts.u.derived
873	->attr.unlimited_polymorphic)
874	{
875	/* Take care about initializing the _len component correctly. */
876	ctree = gfc_class_len_get (var);
877	if (UNLIMITED_POLY (e)(e != __null && e->ts.type == BT_CLASS && e ->ts.u.derived->components && e->ts.u.derived ->components->ts.u.derived && e->ts.u.derived ->components->ts.u.derived->attr.unlimited_polymorphic ))
878	{
879	gfc_expr *len;
880	gfc_se se;
881
882	len = gfc_find_and_cut_at_last_class_ref (e);
883	gfc_add_len_component (len)gfc_add_component_ref(len,"_len");
884	gfc_init_se (&se, NULL__null);
885	gfc_conv_expr (&se, len);
886	if (optional)
887	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 887, __FUNCTION__))->typed.type),
888	cond_optional, se.expr,
889	fold_convert (TREE_TYPE (se.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 889, __FUNCTION__))->typed.type), global_trees[TI_INTEGER_ZERO ])
890	integer_zero_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 889, __FUNCTION__))->typed.type), global_trees[TI_INTEGER_ZERO ]));
891	else
892	tmp = se.expr;
893	gfc_free_expr (len);
894	}
895	else
896	tmp = integer_zero_nodeglobal_trees[TI_INTEGER_ZERO];
897	gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 897, __FUNCTION__))->typed.type), tmp)
898	tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 897, __FUNCTION__))->typed.type), tmp));
899	}
900	/* Pass the address of the class object. */
901	parmse->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, var);
902
903	if (optional && optional_alloc_ptr)
904	parmse->expr = build3_loc (input_location, COND_EXPR,
905	TREE_TYPE (parmse->expr)((contains_struct_check ((parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 905, __FUNCTION__))->typed.type),
906	cond_optional, parmse->expr,
907	fold_convert (TREE_TYPE (parmse->expr),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 907, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
908	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 907, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
909	}
910
911
912	/* Create a new class container, which is required as scalar coarrays
913	have an array descriptor while normal scalars haven't. Optionally,
914	NULL pointer checks are added if the argument is OPTIONAL. */
915
916	static void
917	class_scalar_coarray_to_class (gfc_se parmse, gfc_expr e,
918	gfc_typespec class_ts, bool optional)
919	{
920	tree var, ctree, tmp;
921	stmtblock_t block;
922	gfc_ref *ref;
923	gfc_ref *class_ref;
924
925	gfc_init_block (&block);
926
927	class_ref = NULL__null;
928	for (ref = e->ref; ref; ref = ref->next)
929	{
930	if (ref->type == REF_COMPONENT
931	&& ref->u.c.component->ts.type == BT_CLASS)
932	class_ref = ref;
933	}
934
935	if (class_ref == NULL__null
936	&& e->symtree && e->symtree->n.sym->ts.type == BT_CLASS)
937	tmp = e->symtree->n.sym->backend_decl;
938	else
939	{
940	/* Remove everything after the last class reference, convert the
941	expression and then recover its tailend once more. */
942	gfc_se tmpse;
943	ref = class_ref->next;
944	class_ref->next = NULL__null;
945	gfc_init_se (&tmpse, NULL__null);
946	gfc_conv_expr (&tmpse, e);
947	class_ref->next = ref;
948	tmp = tmpse.expr;
949	}
950
951	var = gfc_typenode_for_spec (&class_ts);
952	var = gfc_create_var (var, "class");
953
954	ctree = gfc_class_vptr_get (var);
955	gfc_add_modify (&block, ctree,
956	fold_convert (TREE_TYPE (ctree), gfc_class_vptr_get (tmp))fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 956, __FUNCTION__))->typed.type), gfc_class_vptr_get (tmp )));
957
958	ctree = gfc_class_data_get (var);
959	tmp = gfc_conv_descriptor_data_get (gfc_class_data_get (tmp));
960	gfc_add_modify (&block, ctree, fold_convert (TREE_TYPE (ctree), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 960, __FUNCTION__))->typed.type), tmp));
961
962	/* Pass the address of the class object. */
963	parmse->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, var);
964
965	if (optional)
966	{
967	tree cond = gfc_conv_expr_present (e->symtree->n.sym);
968	tree tmp2;
969
970	tmp = gfc_finish_block (&block);
971
972	gfc_init_block (&block);
973	tmp2 = gfc_class_data_get (var);
974	gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 974, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
975	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 974, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
976	tmp2 = gfc_finish_block (&block);
977
978	tmp = build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
979	cond, tmp, tmp2);
980	gfc_add_expr_to_block (&parmse->pre, tmp);
981	}
982	else
983	gfc_add_block_to_block (&parmse->pre, &block);
984	}
985
986
987	/* Takes an intrinsic type expression and returns the address of a temporary
988	class object of the 'declared' type. */
989	void
990	gfc_conv_intrinsic_to_class (gfc_se parmse, gfc_expr e,
991	gfc_typespec class_ts)
992	{
993	gfc_symbol *vtab;
994	gfc_ss *ss;
995	tree ctree;
996	tree var;
997	tree tmp;
998	int dim;
999
1000	/* The intrinsic type needs to be converted to a temporary
1001	CLASS object. */
1002	tmp = gfc_typenode_for_spec (&class_ts);
1003	var = gfc_create_var (tmp, "class");
1004
1005	/* Set the vptr. */
1006	ctree = gfc_class_vptr_get (var);
1007
1008	vtab = gfc_find_vtab (&e->ts);
1009	gcc_assert (vtab)((void)(!(vtab) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1009, __FUNCTION__), 0 : 0));
1010	tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, gfc_get_symbol_decl (vtab));
1011	gfc_add_modify (&parmse->pre, ctree,
1012	fold_convert (TREE_TYPE (ctree), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1012, __FUNCTION__))->typed.type), tmp));
1013
1014	/* Now set the data field. */
1015	ctree = gfc_class_data_get (var);
1016	if (parmse->ss && parmse->ss->info->useflags)
1017	{
1018	/* For an array reference in an elemental procedure call we need
1019	to retain the ss to provide the scalarized array reference. */
1020	gfc_conv_expr_reference (parmse, e);
1021	tmp = fold_convert (TREE_TYPE (ctree), parmse->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1021, __FUNCTION__))->typed.type), parmse->expr);
1022	gfc_add_modify (&parmse->pre, ctree, tmp);
1023	}
1024	else
1025	{
1026	ss = gfc_walk_expr (e);
1027	if (ss == gfc_ss_terminator)
1028	{
1029	parmse->ss = NULL__null;
1030	gfc_conv_expr_reference (parmse, e);
1031	if (class_ts.u.derived->components->as
1032	&& class_ts.u.derived->components->as->type == AS_ASSUMED_RANK)
1033	{
1034	tmp = gfc_conv_scalar_to_descriptor (parmse, parmse->expr,
1035	gfc_expr_attr (e));
1036	tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
1037	TREE_TYPE (ctree)((contains_struct_check ((ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1037, __FUNCTION__))->typed.type), tmp);
1038	}
1039	else
1040	tmp = fold_convert (TREE_TYPE (ctree), parmse->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1040, __FUNCTION__))->typed.type), parmse->expr);
1041	gfc_add_modify (&parmse->pre, ctree, tmp);
1042	}
1043	else
1044	{
1045	parmse->ss = ss;
1046	parmse->use_offset = 1;
1047	gfc_conv_expr_descriptor (parmse, e);
1048
1049	/* Array references with vector subscripts and non-variable expressions
1050	need be converted to a one-based descriptor. */
1051	if (e->expr_type != EXPR_VARIABLE)
1052	{
1053	for (dim = 0; dim < e->rank; ++dim)
1054	gfc_conv_shift_descriptor_lbound (&parmse->pre, parmse->expr,
1055	dim, gfc_index_one_nodegfc_rank_cst[1]);
1056	}
1057
1058	if (class_ts.u.derived->components->as->rank != e->rank)
1059	{
1060	tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
1061	TREE_TYPE (ctree)((contains_struct_check ((ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1061, __FUNCTION__))->typed.type), parmse->expr);
1062	gfc_add_modify (&parmse->pre, ctree, tmp);
1063	}
1064	else
1065	gfc_add_modify (&parmse->pre, ctree, parmse->expr);
1066	}
1067	}
1068
1069	gcc_assert (class_ts.type == BT_CLASS)((void)(!(class_ts.type == BT_CLASS) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1069, __FUNCTION__), 0 : 0));
1070	if (class_ts.u.derived->components->ts.type == BT_DERIVED
1071	&& class_ts.u.derived->components->ts.u.derived
1072	->attr.unlimited_polymorphic)
1073	{
1074	ctree = gfc_class_len_get (var);
1075	/* When the actual arg is a char array, then set the _len component of the
1076	unlimited polymorphic entity to the length of the string. */
1077	if (e->ts.type == BT_CHARACTER)
1078	{
1079	/* Start with parmse->string_length because this seems to be set to a
1080	correct value more often. */
1081	if (parmse->string_length)
1082	tmp = parmse->string_length;
1083	/* When the string_length is not yet set, then try the backend_decl of
1084	the cl. */
1085	else if (e->ts.u.cl->backend_decl)
1086	tmp = e->ts.u.cl->backend_decl;
1087	/* If both of the above approaches fail, then try to generate an
1088	expression from the input, which is only feasible currently, when the
1089	expression can be evaluated to a constant one. */
1090	else
1091	{
1092	/* Try to simplify the expression. */
1093	gfc_simplify_expr (e, 0);
1094	if (e->expr_type == EXPR_CONSTANT && !e->ts.u.cl->resolved)
1095	{
1096	/* Amazingly all data is present to compute the length of a
1097	constant string, but the expression is not yet there. */
1098	e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER,
1099	gfc_charlen_int_kind,
1100	&e->where);
1101	mpz_set_ui__gmpz_set_ui (e->ts.u.cl->length->value.integer,
1102	e->value.character.length);
1103	gfc_conv_const_charlen (e->ts.u.cl);
1104	e->ts.u.cl->resolved = 1;
1105	tmp = e->ts.u.cl->backend_decl;
1106	}
1107	else
1108	{
1109	gfc_error ("Cannot compute the length of the char array "
1110	"at %L.", &e->where);
1111	}
1112	}
1113	}
1114	else
1115	tmp = integer_zero_nodeglobal_trees[TI_INTEGER_ZERO];
1116
1117	gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1117, __FUNCTION__))->typed.type), tmp));
1118	}
1119	else if (class_ts.type == BT_CLASS
1120	&& class_ts.u.derived->components
1121	&& class_ts.u.derived->components->ts.u
1122	.derived->attr.unlimited_polymorphic)
1123	{
1124	ctree = gfc_class_len_get (var);
1125	gfc_add_modify (&parmse->pre, ctree,
1126	fold_convert (TREE_TYPE (ctree),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1126, __FUNCTION__))->typed.type), global_trees[TI_INTEGER_ZERO ])
1127	integer_zero_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1126, __FUNCTION__))->typed.type), global_trees[TI_INTEGER_ZERO ]));
1128	}
1129	/* Pass the address of the class object. */
1130	parmse->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, var);
1131	}
1132
1133
1134	/* Takes a scalarized class array expression and returns the
1135	address of a temporary scalar class object of the 'declared'
1136	type.
1137	OOP-TODO: This could be improved by adding code that branched on
1138	the dynamic type being the same as the declared type. In this case
1139	the original class expression can be passed directly.
1140	optional_alloc_ptr is false when the dummy is neither allocatable
1141	nor a pointer; that's relevant for the optional handling.
1142	Set copyback to true if class container's _data and _vtab pointers
1143	might get modified. */
1144
1145	void
1146	gfc_conv_class_to_class (gfc_se parmse, gfc_expr e, gfc_typespec class_ts,
1147	bool elemental, bool copyback, bool optional,
1148	bool optional_alloc_ptr)
1149	{
1150	tree ctree;
1151	tree var;
1152	tree tmp;
1153	tree vptr;
1154	tree cond = NULL_TREE(tree) __null;
1155	tree slen = NULL_TREE(tree) __null;
1156	gfc_ref *ref;
1157	gfc_ref *class_ref;
1158	stmtblock_t block;
1159	bool full_array = false;
1160
1161	gfc_init_block (&block);
1162
1163	class_ref = NULL__null;
1164	for (ref = e->ref; ref; ref = ref->next)
1165	{
1166	if (ref->type == REF_COMPONENT
1167	&& ref->u.c.component->ts.type == BT_CLASS)
1168	class_ref = ref;
1169
1170	if (ref->next == NULL__null)
1171	break;
1172	}
1173
1174	if ((ref == NULL__null \|\| class_ref == ref)
1175	&& !(gfc_is_class_array_function (e) && parmse->class_vptr != NULL_TREE(tree) __null)
1176	&& (!class_ts.u.derived->components->as
1177	\|\| class_ts.u.derived->components->as->rank != -1))
1178	return;
1179
1180	/* Test for FULL_ARRAY. */
1181	if (e->rank == 0
1182	&& ((gfc_expr_attr (e).codimension && gfc_expr_attr (e).dimension)
1183	\|\| (class_ts.u.derived->components->as
1184	&& class_ts.u.derived->components->as->type == AS_ASSUMED_RANK)))
1185	full_array = true;
1186	else
1187	gfc_is_class_array_ref (e, &full_array);
1188
1189	/* The derived type needs to be converted to a temporary
1190	CLASS object. */
1191	tmp = gfc_typenode_for_spec (&class_ts);
1192	var = gfc_create_var (tmp, "class");
1193
1194	/* Set the data. */
1195	ctree = gfc_class_data_get (var);
1196	if (class_ts.u.derived->components->as
1197	&& e->rank != class_ts.u.derived->components->as->rank)
1198	{
1199	if (e->rank == 0)
1200	{
1201	tree type = get_scalar_to_descriptor_type (parmse->expr,
1202	gfc_expr_attr (e));
1203	gfc_add_modify (&block, gfc_conv_descriptor_dtype (ctree),
1204	gfc_get_dtype (type));
1205
1206	tmp = gfc_class_data_get (parmse->expr);
1207	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-expr.cc" , 1207, __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-expr.cc" , 1207, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
1208	tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
1209
1210	gfc_conv_descriptor_data_set (&block, ctree, tmp);
1211	}
1212	else
1213	class_array_data_assign (&block, ctree, parmse->expr, false);
1214	}
1215	else
1216	{
1217	if (TREE_TYPE (parmse->expr)((contains_struct_check ((parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1217, __FUNCTION__))->typed.type) != TREE_TYPE (ctree)((contains_struct_check ((ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1217, __FUNCTION__))->typed.type))
1218	parmse->expr = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
1219	TREE_TYPE (ctree)((contains_struct_check ((ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1219, __FUNCTION__))->typed.type), parmse->expr);
1220	gfc_add_modify (&block, ctree, parmse->expr);
1221	}
1222
1223	/* Return the data component, except in the case of scalarized array
1224	references, where nullification of the cannot occur and so there
1225	is no need. */
1226	if (!elemental && full_array && copyback)
1227	{
1228	if (class_ts.u.derived->components->as
1229	&& e->rank != class_ts.u.derived->components->as->rank)
1230	{
1231	if (e->rank == 0)
1232	{
1233	tmp = gfc_class_data_get (parmse->expr);
1234	gfc_add_modify (&parmse->post, tmp,
1235	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-expr.cc" , 1235, __FUNCTION__))->typed.type), gfc_conv_descriptor_data_get (ctree))
1236	gfc_conv_descriptor_data_get (ctree))fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1235, __FUNCTION__))->typed.type), gfc_conv_descriptor_data_get (ctree)));
1237	}
1238	else
1239	class_array_data_assign (&parmse->post, parmse->expr, ctree, true);
1240	}
1241	else
1242	gfc_add_modify (&parmse->post, parmse->expr, ctree);
1243	}
1244
1245	/* Set the vptr. */
1246	ctree = gfc_class_vptr_get (var);
1247
1248	/* The vptr is the second field of the actual argument.
1249	First we have to find the corresponding class reference. */
1250
1251	tmp = NULL_TREE(tree) __null;
1252	if (gfc_is_class_array_function (e)
1253	&& parmse->class_vptr != NULL_TREE(tree) __null)
1254	tmp = parmse->class_vptr;
1255	else if (class_ref == NULL__null
1256	&& e->symtree && e->symtree->n.sym->ts.type == BT_CLASS)
1257	{
1258	tmp = e->symtree->n.sym->backend_decl;
1259
1260	if (TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == FUNCTION_DECL)
1261	tmp = gfc_get_fake_result_decl (e->symtree->n.sym, 0);
1262
1263	if (DECL_LANG_SPECIFIC (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1263, __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-expr.cc" , 1263, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
1264	tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp)(((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1264, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
1265
1266	slen = build_zero_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1267	}
1268	else
1269	{
1270	/* Remove everything after the last class reference, convert the
1271	expression and then recover its tailend once more. */
1272	gfc_se tmpse;
1273	ref = class_ref->next;
1274	class_ref->next = NULL__null;
1275	gfc_init_se (&tmpse, NULL__null);
1276	gfc_conv_expr (&tmpse, e);
1277	class_ref->next = ref;
1278	tmp = tmpse.expr;
1279	slen = tmpse.string_length;
1280	}
1281
1282	gcc_assert (tmp != NULL_TREE)((void)(!(tmp != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1282, __FUNCTION__), 0 : 0));
1283
1284	/* Dereference if needs be. */
1285	if (TREE_CODE (TREE_TYPE (tmp))((enum tree_code) (((contains_struct_check ((tmp), (TS_TYPED) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1285, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE)
1286	tmp = build_fold_indirect_ref_loc (input_location, tmp);
1287
1288	if (!(gfc_is_class_array_function (e) && parmse->class_vptr))
1289	vptr = gfc_class_vptr_get (tmp);
1290	else
1291	vptr = tmp;
1292
1293	gfc_add_modify (&block, ctree,
1294	fold_convert (TREE_TYPE (ctree), vptr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1294, __FUNCTION__))->typed.type), vptr));
1295
1296	/* Return the vptr component, except in the case of scalarized array
1297	references, where the dynamic type cannot change. */
1298	if (!elemental && full_array && copyback)
1299	gfc_add_modify (&parmse->post, vptr,
1300	fold_convert (TREE_TYPE (vptr), ctree)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (vptr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1300, __FUNCTION__))->typed.type), ctree));
1301
1302	/* For unlimited polymorphic objects also set the _len component. */
1303	if (class_ts.type == BT_CLASS
1304	&& class_ts.u.derived->components
1305	&& class_ts.u.derived->components->ts.u
1306	.derived->attr.unlimited_polymorphic)
1307	{
1308	ctree = gfc_class_len_get (var);
1309	if (UNLIMITED_POLY (e)(e != __null && e->ts.type == BT_CLASS && e ->ts.u.derived->components && e->ts.u.derived ->components->ts.u.derived && e->ts.u.derived ->components->ts.u.derived->attr.unlimited_polymorphic ))
1310	tmp = gfc_class_len_get (tmp);
1311	else if (e->ts.type == BT_CHARACTER)
1312	{
1313	gcc_assert (slen != NULL_TREE)((void)(!(slen != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1313, __FUNCTION__), 0 : 0));
1314	tmp = slen;
1315	}
1316	else
1317	tmp = build_zero_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1318	gfc_add_modify (&parmse->pre, ctree,
1319	fold_convert (TREE_TYPE (ctree), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctree), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1319, __FUNCTION__))->typed.type), tmp));
1320
1321	/* Return the len component, except in the case of scalarized array
1322	references, where the dynamic type cannot change. */
1323	if (!elemental && full_array && copyback
1324	&& (UNLIMITED_POLY (e)(e != __null && e->ts.type == BT_CLASS && e ->ts.u.derived->components && e->ts.u.derived ->components->ts.u.derived && e->ts.u.derived ->components->ts.u.derived->attr.unlimited_polymorphic ) \|\| VAR_P (tmp)(((enum tree_code) (tmp)->base.code) == VAR_DECL)))
1325	gfc_add_modify (&parmse->post, tmp,
1326	fold_convert (TREE_TYPE (tmp), ctree)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1326, __FUNCTION__))->typed.type), ctree));
1327	}
1328
1329	if (optional)
1330	{
1331	tree tmp2;
1332
1333	cond = gfc_conv_expr_present (e->symtree->n.sym);
1334	/* parmse->pre may contain some preparatory instructions for the
1335	temporary array descriptor. Those may only be executed when the
1336	optional argument is set, therefore add parmse->pre's instructions
1337	to block, which is later guarded by an if (optional_arg_given). */
1338	gfc_add_block_to_block (&parmse->pre, &block);
1339	block.head = parmse->pre.head;
1340	parmse->pre.head = NULL_TREE(tree) __null;
1341	tmp = gfc_finish_block (&block);
1342
1343	if (optional_alloc_ptr)
1344	tmp2 = build_empty_stmt (input_location);
1345	else
1346	{
1347	gfc_init_block (&block);
1348
1349	tmp2 = gfc_conv_descriptor_data_get (gfc_class_data_get (var));
1350	gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1350, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
1351	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1350, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
1352	tmp2 = gfc_finish_block (&block);
1353	}
1354
1355	tmp = build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1356	cond, tmp, tmp2);
1357	gfc_add_expr_to_block (&parmse->pre, tmp);
1358	}
1359	else
1360	gfc_add_block_to_block (&parmse->pre, &block);
1361
1362	/* Pass the address of the class object. */
1363	parmse->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, var);
1364
1365	if (optional && optional_alloc_ptr)
1366	parmse->expr = build3_loc (input_location, COND_EXPR,
1367	TREE_TYPE (parmse->expr)((contains_struct_check ((parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1367, __FUNCTION__))->typed.type),
1368	cond, parmse->expr,
1369	fold_convert (TREE_TYPE (parmse->expr),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1369, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
1370	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1369, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
1371	}
1372
1373
1374	/* Given a class array declaration and an index, returns the address
1375	of the referenced element. */
1376
1377	static tree
1378	gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp,
1379	bool unlimited)
1380	{
1381	tree data, size, tmp, ctmp, offset, ptr;
1382
1383	data = data_comp != NULL_TREE(tree) __null ? data_comp :
1384	gfc_class_data_get (class_decl);
1385	size = gfc_class_vtab_size_get (class_decl);
1386
1387	if (unlimited)
1388	{
1389	tmp = fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, gfc_class_len_get (class_decl))
1390	gfc_class_len_get (class_decl))fold_convert_loc (((location_t) 0), gfc_array_index_type, gfc_class_len_get (class_decl));
1391	ctmp = fold_build2_loc (input_location, MULT_EXPR,
1392	gfc_array_index_type, size, tmp);
1393	tmp = fold_build2_loc (input_location, GT_EXPR,
1394	logical_type_node, tmp,
1395	build_zero_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1395, __FUNCTION__))->typed.type)));
1396	size = fold_build3_loc (input_location, COND_EXPR,
1397	gfc_array_index_type, tmp, ctmp, size);
1398	}
1399
1400	offset = fold_build2_loc (input_location, MULT_EXPR,
1401	gfc_array_index_type,
1402	index, size);
1403
1404	data = gfc_conv_descriptor_data_get (data);
1405	ptr = fold_convert (pvoid_type_node, data)fold_convert_loc (((location_t) 0), pvoid_type_node, data);
1406	ptr = fold_build_pointer_plus_loc (input_location, ptr, offset);
1407	return fold_convert (TREE_TYPE (data), ptr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (data), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1407, __FUNCTION__))->typed.type), ptr);
1408	}
1409
1410
1411	/* Copies one class expression to another, assuming that if either
1412	'to' or 'from' are arrays they are packed. Should 'from' be
1413	NULL_TREE, the initialization expression for 'to' is used, assuming
1414	that the _vptr is set. */
1415
1416	tree
1417	gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
1418	{
1419	tree fcn;
1420	tree fcn_type;
1421	tree from_data;
1422	tree from_len;
1423	tree to_data;
1424	tree to_len;
1425	tree to_ref;
1426	tree from_ref;
1427	vec<tree, va_gc> *args;
1428	tree tmp;
1429	tree stdcopy;
1430	tree extcopy;
1431	tree index;
1432	bool is_from_desc = false, is_to_class = false;
1433
1434	args = NULL__null;
1435	/* To prevent warnings on uninitialized variables. */
1436	from_len = to_len = NULL_TREE(tree) __null;
1437
1438	if (from != NULL_TREE(tree) __null)
1439	fcn = gfc_class_vtab_copy_get (from);
1440	else
1441	fcn = gfc_class_vtab_copy_get (to);
1442
1443	fcn_type = TREE_TYPE (TREE_TYPE (fcn))((contains_struct_check ((((contains_struct_check ((fcn), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1443, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1443, __FUNCTION__))->typed.type);
1444
1445	if (from != NULL_TREE(tree) __null)
1446	{
1447	is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from))((tree_class_check ((((contains_struct_check ((from), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1447, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1447, __FUNCTION__))->type_common.lang_flag_1);
1448	if (is_from_desc)
1449	{
1450	from_data = from;
1451	from = GFC_DECL_SAVED_DESCRIPTOR (from)(((contains_struct_check ((from), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1451, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
1452	}
1453	else
1454	{
1455	/* Check that from is a class. When the class is part of a coarray,
1456	then from is a common pointer and is to be used as is. */
1457	tmp = POINTER_TYPE_P (TREE_TYPE (from))(((enum tree_code) (((contains_struct_check ((from), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1457, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((from), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1457, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )
1458	? build_fold_indirect_ref (from)build_fold_indirect_ref_loc (((location_t) 0), from) : from;
1459	from_data =
1460	(GFC_CLASS_TYPE_P (TREE_TYPE (tmp))((tree_class_check ((((contains_struct_check ((tmp), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1460, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1460, __FUNCTION__))->type_common.lang_flag_4)
1461	\|\| (DECL_P (tmp)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (tmp)->base.code))] == tcc_declaration) && GFC_DECL_CLASS (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1461, __FUNCTION__))->decl_common.lang_flag_8)))
1462	? gfc_class_data_get (from) : from;
1463	is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data))((tree_class_check ((((contains_struct_check ((from_data), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1463, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1463, __FUNCTION__))->type_common.lang_flag_1);
1464	}
1465	}
1466	else
1467	from_data = gfc_class_vtab_def_init_get (to);
1468
1469	if (unlimited)
1470	{
1471	if (from != NULL_TREE(tree) __null && unlimited)
1472	from_len = gfc_class_len_or_zero_get (from);
1473	else
1474	from_len = build_zero_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1475	}
1476
1477	if (GFC_CLASS_TYPE_P (TREE_TYPE (to))((tree_class_check ((((contains_struct_check ((to), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1477, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1477, __FUNCTION__))->type_common.lang_flag_4))
1478	{
1479	is_to_class = true;
1480	to_data = gfc_class_data_get (to);
1481	if (unlimited)
1482	to_len = gfc_class_len_get (to);
1483	}
1484	else
1485	/* When to is a BT_DERIVED and not a BT_CLASS, then to_data == to. */
1486	to_data = to;
1487
1488	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (to_data))((tree_class_check ((((contains_struct_check ((to_data), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1488, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1488, __FUNCTION__))->type_common.lang_flag_1))
1489	{
1490	stmtblock_t loopbody;
1491	stmtblock_t body;
1492	stmtblock_t ifbody;
1493	gfc_loopinfo loop;
1494	tree orig_nelems = nelems; /* Needed for bounds check. */
1495
1496	gfc_init_block (&body);
1497	tmp = fold_build2_loc (input_location, MINUS_EXPR,
1498	gfc_array_index_type, nelems,
1499	gfc_index_one_nodegfc_rank_cst[1]);
1500	nelems = gfc_evaluate_now (tmp, &body);
1501	index = gfc_create_var (gfc_array_index_type, "S");
1502
1503	if (is_from_desc)
1504	{
1505	from_ref = gfc_get_class_array_ref (index, from, from_data,
1506	unlimited);
1507	vec_safe_push (args, from_ref);
1508	}
1509	else
1510	vec_safe_push (args, from_data);
1511
1512	if (is_to_class)
1513	to_ref = gfc_get_class_array_ref (index, to, to_data, unlimited);
1514	else
1515	{
1516	tmp = gfc_conv_array_data (to);
1517	tmp = build_fold_indirect_ref_loc (input_location, tmp);
1518	to_ref = gfc_build_addr_expr (NULL_TREE(tree) __null,
1519	gfc_build_array_ref (tmp, index, to));
1520	}
1521	vec_safe_push (args, to_ref);
1522
1523	/* Add bounds check. */
1524	if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0)) > 0 && is_from_desc)
1525	{
1526	char *msg;
1527	const char *name = "<<unknown>>";
1528	tree from_len;
1529
1530	if (DECL_P (to)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (to)->base.code))] == tcc_declaration))
1531	name = (const char *)(DECL_NAME (to)((contains_struct_check ((to), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1531, __FUNCTION__))->decl_minimal.name)->identifier.id.str);
1532
1533	from_len = gfc_conv_descriptor_size (from_data, 1);
1534	from_len = fold_convert (TREE_TYPE (orig_nelems), from_len)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (orig_nelems), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1534, __FUNCTION__))->typed.type), from_len);
1535	tmp = fold_build2_loc (input_location, NE_EXPR,
1536	logical_type_node, from_len, orig_nelems);
1537	msg = xasprintf ("Array bound mismatch for dimension %d "
1538	"of array '%s' (%%ld/%%ld)",
1539	1, name);
1540
1541	gfc_trans_runtime_check (true, false, tmp, &body,
1542	&gfc_current_locus, msg,
1543	fold_convert (long_integer_type_node, orig_nelems)fold_convert_loc (((location_t) 0), integer_types[itk_long], orig_nelems ),
1544	fold_convert (long_integer_type_node, from_len)fold_convert_loc (((location_t) 0), integer_types[itk_long], from_len ));
1545
1546	free (msg);
1547	}
1548
1549	tmp = build_call_vec (fcn_type, fcn, args);
1550
1551	/* Build the body of the loop. */
1552	gfc_init_block (&loopbody);
1553	gfc_add_expr_to_block (&loopbody, tmp);
1554
1555	/* Build the loop and return. */
1556	gfc_init_loopinfo (&loop);
1557	loop.dimen = 1;
1558	loop.from[0] = gfc_index_zero_nodegfc_rank_cst[0];
1559	loop.loopvar[0] = index;
1560	loop.to[0] = nelems;
1561	gfc_trans_scalarizing_loops (&loop, &loopbody);
1562	gfc_init_block (&ifbody);
1563	gfc_add_block_to_block (&ifbody, &loop.pre);
1564	stdcopy = gfc_finish_block (&ifbody);
1565	/* In initialization mode from_len is a constant zero. */
1566	if (unlimited && !integer_zerop (from_len))
1567	{
1568	vec_safe_push (args, from_len);
1569	vec_safe_push (args, to_len);
1570	tmp = build_call_vec (fcn_type, fcn, args);
1571	/* Build the body of the loop. */
1572	gfc_init_block (&loopbody);
1573	gfc_add_expr_to_block (&loopbody, tmp);
1574
1575	/* Build the loop and return. */
1576	gfc_init_loopinfo (&loop);
1577	loop.dimen = 1;
1578	loop.from[0] = gfc_index_zero_nodegfc_rank_cst[0];
1579	loop.loopvar[0] = index;
1580	loop.to[0] = nelems;
1581	gfc_trans_scalarizing_loops (&loop, &loopbody);
1582	gfc_init_block (&ifbody);
1583	gfc_add_block_to_block (&ifbody, &loop.pre);
1584	extcopy = gfc_finish_block (&ifbody);
1585
1586	tmp = fold_build2_loc (input_location, GT_EXPR,
1587	logical_type_node, from_len,
1588	build_zero_cst (TREE_TYPE (from_len)((contains_struct_check ((from_len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1588, __FUNCTION__))->typed.type)));
1589	tmp = fold_build3_loc (input_location, COND_EXPR,
1590	void_type_nodeglobal_trees[TI_VOID_TYPE], tmp, extcopy, stdcopy);
1591	gfc_add_expr_to_block (&body, tmp);
1592	tmp = gfc_finish_block (&body);
1593	}
1594	else
1595	{
1596	gfc_add_expr_to_block (&body, stdcopy);
1597	tmp = gfc_finish_block (&body);
1598	}
1599	gfc_cleanup_loop (&loop);
1600	}
1601	else
1602	{
1603	gcc_assert (!is_from_desc)((void)(!(!is_from_desc) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1603, __FUNCTION__), 0 : 0));
1604	vec_safe_push (args, from_data);
1605	vec_safe_push (args, to_data);
1606	stdcopy = build_call_vec (fcn_type, fcn, args);
1607
1608	/* In initialization mode from_len is a constant zero. */
1609	if (unlimited && !integer_zerop (from_len))
1610	{
1611	vec_safe_push (args, from_len);
1612	vec_safe_push (args, to_len);
1613	extcopy = build_call_vec (fcn_type, unshare_expr (fcn), args);
1614	tmp = fold_build2_loc (input_location, GT_EXPR,
1615	logical_type_node, from_len,
1616	build_zero_cst (TREE_TYPE (from_len)((contains_struct_check ((from_len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1616, __FUNCTION__))->typed.type)));
1617	tmp = fold_build3_loc (input_location, COND_EXPR,
1618	void_type_nodeglobal_trees[TI_VOID_TYPE], tmp, extcopy, stdcopy);
1619	}
1620	else
1621	tmp = stdcopy;
1622	}
1623
1624	/* Only copy _def_init to to_data, when it is not a NULL-pointer. */
1625	if (from == NULL_TREE(tree) __null)
1626	{
1627	tree cond;
1628	cond = fold_build2_loc (input_location, NE_EXPR,
1629	logical_type_node,
1630	from_data, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
1631	tmp = fold_build3_loc (input_location, COND_EXPR,
1632	void_type_nodeglobal_trees[TI_VOID_TYPE], cond,
1633	tmp, build_empty_stmt (input_location));
1634	}
1635
1636	return tmp;
1637	}
1638
1639
1640	static tree
1641	gfc_trans_class_array_init_assign (gfc_expr rhs, gfc_expr lhs, gfc_expr *obj)
1642	{
1643	gfc_actual_arglist *actual;
1644	gfc_expr *ppc;
1645	gfc_code *ppc_code;
1646	tree res;
1647
1648	actual = gfc_get_actual_arglist ()((gfc_actual_arglist *) xcalloc (1, sizeof (gfc_actual_arglist )));
1649	actual->expr = gfc_copy_expr (rhs);
1650	actual->next = gfc_get_actual_arglist ()((gfc_actual_arglist *) xcalloc (1, sizeof (gfc_actual_arglist )));
1651	actual->next->expr = gfc_copy_expr (lhs);
1652	ppc = gfc_copy_expr (obj);
1653	gfc_add_vptr_component (ppc)gfc_add_component_ref(ppc,"_vptr");
1654	gfc_add_component_ref (ppc, "_copy");
1655	ppc_code = gfc_get_code (EXEC_CALL);
1656	ppc_code->resolved_sym = ppc->symtree->n.sym;
1657	/* Although '_copy' is set to be elemental in class.cc, it is
1658	not staying that way. Find out why, sometime.... */
1659	ppc_code->resolved_sym->attr.elemental = 1;
1660	ppc_code->ext.actual = actual;
1661	ppc_code->expr1 = ppc;
1662	/* Since '_copy' is elemental, the scalarizer will take care
1663	of arrays in gfc_trans_call. */
1664	res = gfc_trans_call (ppc_code, false, NULL__null, NULL__null, false);
1665	gfc_free_statements (ppc_code);
1666
1667	if (UNLIMITED_POLY(obj)(obj != __null && obj->ts.type == BT_CLASS && obj->ts.u.derived->components && obj->ts.u. derived->components->ts.u.derived && obj->ts .u.derived->components->ts.u.derived->attr.unlimited_polymorphic ))
1668	{
1669	/* Check if rhs is non-NULL. */
1670	gfc_se src;
1671	gfc_init_se (&src, NULL__null);
1672	gfc_conv_expr (&src, rhs);
1673	src.expr = gfc_build_addr_expr (NULL_TREE(tree) __null, src.expr);
1674	tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
1675	src.expr, fold_convert (TREE_TYPE (src.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (src.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1675, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
1676	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (src.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1675, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
1677	res = build3_loc (input_location, COND_EXPR, TREE_TYPE (res)((contains_struct_check ((res), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1677, __FUNCTION__))->typed.type), cond, res,
1678	build_empty_stmt (input_location));
1679	}
1680
1681	return res;
1682	}
1683
1684	/* Special case for initializing a polymorphic dummy with INTENT(OUT).
1685	A MEMCPY is needed to copy the full data from the default initializer
1686	of the dynamic type. */
1687
1688	tree
1689	gfc_trans_class_init_assign (gfc_code *code)
1690	{
1691	stmtblock_t block;
1692	tree tmp;
1693	gfc_se dst,src,memsz;
1694	gfc_expr lhs, rhs, *sz;
1695
1696	gfc_start_block (&block);
1697
1698	lhs = gfc_copy_expr (code->expr1);
1699
1700	rhs = gfc_copy_expr (code->expr1);
1701	gfc_add_vptr_component (rhs)gfc_add_component_ref(rhs,"_vptr");
1702
1703	/* Make sure that the component backend_decls have been built, which
1704	will not have happened if the derived types concerned have not
1705	been referenced. */
1706	gfc_get_derived_type (rhs->ts.u.derived);
1707	gfc_add_def_init_component (rhs)gfc_add_component_ref(rhs,"_def_init");
1708	/* The _def_init is always scalar. */
1709	rhs->rank = 0;
1710
1711	if (code->expr1->ts.type == BT_CLASS
1712	&& CLASS_DATA (code->expr1)code->expr1->ts.u.derived->components->attr.dimension)
1713	{
1714	gfc_array_spec tmparr = gfc_get_array_spec ()((gfc_array_spec ) xcalloc (1, sizeof (gfc_array_spec)));
1715	tmparr = CLASS_DATA (code->expr1)code->expr1->ts.u.derived->components->as;
1716	/* Adding the array ref to the class expression results in correct
1717	indexing to the dynamic type. */
1718	gfc_add_full_array_ref (lhs, tmparr);
1719	tmp = gfc_trans_class_array_init_assign (rhs, lhs, code->expr1);
1720	}
1721	else
1722	{
1723	/* Scalar initialization needs the _data component. */
1724	gfc_add_data_component (lhs)gfc_add_component_ref(lhs,"_data");
1725	sz = gfc_copy_expr (code->expr1);
1726	gfc_add_vptr_component (sz)gfc_add_component_ref(sz,"_vptr");
1727	gfc_add_size_component (sz)gfc_add_component_ref(sz,"_size");
1728
1729	gfc_init_se (&dst, NULL__null);
1730	gfc_init_se (&src, NULL__null);
1731	gfc_init_se (&memsz, NULL__null);
1732	gfc_conv_expr (&dst, lhs);
1733	gfc_conv_expr (&src, rhs);
1734	gfc_conv_expr (&memsz, sz);
1735	gfc_add_block_to_block (&block, &src.pre);
1736	src.expr = gfc_build_addr_expr (NULL_TREE(tree) __null, src.expr);
1737
1738	tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
1739
1740	if (UNLIMITED_POLY(code->expr1)(code->expr1 != __null && code->expr1->ts.type == BT_CLASS && code->expr1->ts.u.derived->components && code->expr1->ts.u.derived->components-> ts.u.derived && code->expr1->ts.u.derived->components ->ts.u.derived->attr.unlimited_polymorphic))
1741	{
1742	/* Check if _def_init is non-NULL. */
1743	tree cond = fold_build2_loc (input_location, NE_EXPR,
1744	logical_type_node, src.expr,
1745	fold_convert (TREE_TYPE (src.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (src.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1745, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
1746	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (src.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1745, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
1747	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1747, __FUNCTION__))->typed.type), cond,
1748	tmp, build_empty_stmt (input_location));
1749	}
1750	}
1751
1752	if (code->expr1->symtree->n.sym->attr.dummy
1753	&& (code->expr1->symtree->n.sym->attr.optional
1754	\|\| code->expr1->symtree->n.sym->ns->proc_name->attr.entry_master))
1755	{
1756	tree present = gfc_conv_expr_present (code->expr1->symtree->n.sym);
1757	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1757, __FUNCTION__))->typed.type),
1758	present, tmp,
1759	build_empty_stmt (input_location));
1760	}
1761
1762	gfc_add_expr_to_block (&block, tmp);
1763
1764	return gfc_finish_block (&block);
1765	}
1766
1767
1768	/* Class valued elemental function calls or class array elements arriving
1769	in gfc_trans_scalar_assign come here. Wherever possible the vptr copy
1770	is used to ensure that the rhs dynamic type is assigned to the lhs. */
1771
1772	static bool
1773	trans_scalar_class_assign (stmtblock_t block, gfc_se lse, gfc_se *rse)
1774	{
1775	tree fcn;
1776	tree rse_expr;
1777	tree class_data;
1778	tree tmp;
1779	tree zero;
1780	tree cond;
1781	tree final_cond;
1782	stmtblock_t inner_block;
1783	bool is_descriptor;
1784	bool not_call_expr = TREE_CODE (rse->expr)((enum tree_code) (rse->expr)->base.code) != CALL_EXPR;
1785	bool not_lhs_array_type;
1786
1787	/* Temporaries arising from dependencies in assignment get cast as a
1788	character type of the dynamic size of the rhs. Use the vptr copy
1789	for this case. */
1790	tmp = TREE_TYPE (lse->expr)((contains_struct_check ((lse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1790, __FUNCTION__))->typed.type);
1791	not_lhs_array_type = !(tmp && TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == ARRAY_TYPE
1792	&& TYPE_MAX_VALUE (TYPE_DOMAIN (tmp))((tree_check5 ((((tree_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1792, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values )), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1792, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval ) != NULL_TREE(tree) __null);
1793
1794	/* Use ordinary assignment if the rhs is not a call expression or
1795	the lhs is not a class entity or an array(ie. character) type. */
1796	if ((not_call_expr && gfc_get_class_from_expr (lse->expr) == NULL_TREE(tree) __null)
1797	&& not_lhs_array_type)
1798	return false;
1799
1800	/* Ordinary assignment can be used if both sides are class expressions
1801	since the dynamic type is preserved by copying the vptr. This
1802	should only occur, where temporaries are involved. */
1803	if (GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr))((tree_class_check ((((contains_struct_check ((lse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1803, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1803, __FUNCTION__))->type_common.lang_flag_4)
1804	&& GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr))((tree_class_check ((((contains_struct_check ((rse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1804, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1804, __FUNCTION__))->type_common.lang_flag_4))
1805	return false;
1806
1807	/* Fix the class expression and the class data of the rhs. */
1808	if (!GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr))((tree_class_check ((((contains_struct_check ((rse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1808, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1808, __FUNCTION__))->type_common.lang_flag_4)
1809	\|\| not_call_expr)
1810	{
1811	tmp = gfc_get_class_from_expr (rse->expr);
1812	if (tmp == NULL_TREE(tree) __null)
1813	return false;
1814	rse_expr = gfc_evaluate_now (tmp, block);
1815	}
1816	else
1817	rse_expr = gfc_evaluate_now (rse->expr, block);
1818
1819	class_data = gfc_class_data_get (rse_expr);
1820
1821	/* Check that the rhs data is not null. */
1822	is_descriptor = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (class_data))((tree_class_check ((((contains_struct_check ((class_data), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1822, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1822, __FUNCTION__))->type_common.lang_flag_1);
1823	if (is_descriptor)
1824	class_data = gfc_conv_descriptor_data_get (class_data);
1825	class_data = gfc_evaluate_now (class_data, block);
1826
1827	zero = build_int_cst (TREE_TYPE (class_data)((contains_struct_check ((class_data), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1827, __FUNCTION__))->typed.type), 0);
1828	cond = fold_build2_loc (input_location, NE_EXPR,
1829	logical_type_node,
1830	class_data, zero);
1831
1832	/* Copy the rhs to the lhs. */
1833	fcn = gfc_vptr_copy_get (gfc_class_vptr_get (rse_expr));
1834	fcn = build_fold_indirect_ref_loc (input_location, fcn);
1835	tmp = gfc_evaluate_now (gfc_build_addr_expr (NULL__null, rse->expr), block);
1836	tmp = is_descriptor ? tmp : class_data;
1837	tmp = build_call_expr_loc (input_location, fcn, 2, tmp,
1838	gfc_build_addr_expr (NULL__null, lse->expr));
1839	gfc_add_expr_to_block (block, tmp);
1840
1841	/* Only elemental function results need to be finalised and freed. */
1842	if (not_call_expr)
1843	return true;
1844
1845	/* Finalize the class data if needed. */
1846	gfc_init_block (&inner_block);
1847	fcn = gfc_vptr_final_get (gfc_class_vptr_get (rse_expr));
1848	zero = build_int_cst (TREE_TYPE (fcn)((contains_struct_check ((fcn), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1848, __FUNCTION__))->typed.type), 0);
1849	final_cond = fold_build2_loc (input_location, NE_EXPR,
1850	logical_type_node, fcn, zero);
1851	fcn = build_fold_indirect_ref_loc (input_location, fcn);
1852	tmp = build_call_expr_loc (input_location, fcn, 1, class_data);
1853	tmp = build3_v (COND_EXPR, final_cond,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], final_cond, tmp, build_empty_stmt (input_location))
1854	tmp, build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], final_cond, tmp, build_empty_stmt (input_location));
1855	gfc_add_expr_to_block (&inner_block, tmp);
1856
1857	/* Free the class data. */
1858	tmp = gfc_call_free (class_data);
1859	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))
1860	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, tmp, build_empty_stmt (input_location));
1861	gfc_add_expr_to_block (&inner_block, tmp);
1862
1863	/* Finish the inner block and subject it to the condition on the
1864	class data being non-zero. */
1865	tmp = gfc_finish_block (&inner_block);
1866	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))
1867	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, tmp, build_empty_stmt (input_location));
1868	gfc_add_expr_to_block (block, tmp);
1869
1870	return true;
1871	}
1872
1873	/* End of prototype trans-class.c */
1874
1875
1876	static void
1877	realloc_lhs_warning (bt type, bool array, locus *where)
1878	{
1879	if (array && type != BT_CLASS && type != BT_DERIVED && warn_realloc_lhsglobal_options.x_warn_realloc_lhs)
1880	gfc_warning (OPT_Wrealloc_lhs,
1881	"Code for reallocating the allocatable array at %L will "
1882	"be added", where);
1883	else if (warn_realloc_lhs_allglobal_options.x_warn_realloc_lhs_all)
1884	gfc_warning (OPT_Wrealloc_lhs_all,
1885	"Code for reallocating the allocatable variable at %L "
1886	"will be added", where);
1887	}
1888
1889
1890	static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
1891	gfc_expr *);
1892
1893	/* Copy the scalarization loop variables. */
1894
1895	static void
1896	gfc_copy_se_loopvars (gfc_se * dest, gfc_se * src)
1897	{
1898	dest->ss = src->ss;
1899	dest->loop = src->loop;
1900	}
1901
1902
1903	/* Initialize a simple expression holder.
1904
1905	Care must be taken when multiple se are created with the same parent.
1906	The child se must be kept in sync. The easiest way is to delay creation
1907	of a child se until after the previous se has been translated. */
1908
1909	void
1910	gfc_init_se (gfc_se * se, gfc_se * parent)
1911	{
1912	memset (se, 0, sizeof (gfc_se));
1913	gfc_init_block (&se->pre);
1914	gfc_init_block (&se->finalblock);
1915	gfc_init_block (&se->post);
1916
1917	se->parent = parent;
1918
1919	if (parent)
1920	gfc_copy_se_loopvars (se, parent);
1921	}
1922
1923
1924	/* Advances to the next SS in the chain. Use this rather than setting
1925	se->ss = se->ss->next because all the parents needs to be kept in sync.
1926	See gfc_init_se. */
1927
1928	void
1929	gfc_advance_se_ss_chain (gfc_se * se)
1930	{
1931	gfc_se *p;
1932	gfc_ss *ss;
1933
1934	gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator)((void)(!(se != __null && se->ss != __null && se->ss != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1934, __FUNCTION__), 0 : 0));
1935
1936	p = se;
1937	/* Walk down the parent chain. */
1938	while (p != NULL__null)
1939	{
1940	/* Simple consistency check. */
1941	gcc_assert (p->parent == NULL \|\| p->parent->ss == p->ss((void)(!(p->parent == __null \|\| p->parent->ss == p-> ss \|\| p->parent->ss->nested_ss == p->ss) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1942, __FUNCTION__), 0 : 0))
1942	\|\| p->parent->ss->nested_ss == p->ss)((void)(!(p->parent == __null \|\| p->parent->ss == p-> ss \|\| p->parent->ss->nested_ss == p->ss) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1942, __FUNCTION__), 0 : 0));
1943
1944	/* If we were in a nested loop, the next scalarized expression can be
1945	on the parent ss' next pointer. Thus we should not take the next
1946	pointer blindly, but rather go up one nest level as long as next
1947	is the end of chain. */
1948	ss = p->ss;
1949	while (ss->next == gfc_ss_terminator && ss->parent != NULL__null)
1950	ss = ss->parent;
1951
1952	p->ss = ss->next;
1953
1954	p = p->parent;
1955	}
1956	}
1957
1958
1959	/* Ensures the result of the expression as either a temporary variable
1960	or a constant so that it can be used repeatedly. */
1961
1962	void
1963	gfc_make_safe_expr (gfc_se * se)
1964	{
1965	tree var;
1966
1967	if (CONSTANT_CLASS_P (se->expr)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (se->expr)->base.code))] == tcc_constant))
1968	return;
1969
1970	/* We need a temporary for this result. */
1971	var = gfc_create_var (TREE_TYPE (se->expr)((contains_struct_check ((se->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1971, __FUNCTION__))->typed.type), NULL__null);
1972	gfc_add_modify (&se->pre, var, se->expr);
1973	se->expr = var;
1974	}
1975
1976
1977	/* Return an expression which determines if a dummy parameter is present.
1978	Also used for arguments to procedures with multiple entry points. */
1979
1980	tree
1981	gfc_conv_expr_present (gfc_symbol * sym, bool use_saved_desc)
1982	{
1983	tree decl, orig_decl, cond;
1984
1985	gcc_assert (sym->attr.dummy)((void)(!(sym->attr.dummy) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1985, __FUNCTION__), 0 : 0));
1986	orig_decl = decl = gfc_get_symbol_decl (sym);
1987
1988	/* Intrinsic scalars with VALUE attribute which are passed by value
1989	use a hidden argument to denote the present status. */
1990	if (sym->attr.value && !sym->attr.dimension
1991	&& sym->ts.type != BT_CLASS && !gfc_bt_struct (sym->ts.type)((sym->ts.type) == BT_DERIVED \|\| (sym->ts.type) == BT_UNION ))
1992	{
1993	char name[GFC_MAX_SYMBOL_LEN63 + 2];
1994	tree tree_name;
1995
1996	gcc_assert (TREE_CODE (decl) == PARM_DECL)((void)(!(((enum tree_code) (decl)->base.code) == PARM_DECL ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 1996, __FUNCTION__), 0 : 0));
1997	name[0] = '.';
1998	strcpy (&name[1], sym->name);
1999	tree_name = get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name ), strlen (name)) : get_identifier (name));
2000
2001	/* Walk function argument list to find hidden arg. */
2002	cond = DECL_ARGUMENTS (DECL_CONTEXT (decl))((tree_check ((((contains_struct_check ((decl), (TS_DECL_MINIMAL ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2002, __FUNCTION__))->decl_minimal.context)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2002, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments );
2003	for ( ; cond != NULL_TREE(tree) __null; cond = TREE_CHAIN (cond)((contains_struct_check ((cond), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2003, __FUNCTION__))->common.chain))
2004	if (DECL_NAME (cond)((contains_struct_check ((cond), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2004, __FUNCTION__))->decl_minimal.name) == tree_name
2005	&& DECL_ARTIFICIAL (cond)((contains_struct_check ((cond), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2005, __FUNCTION__))->decl_common.artificial_flag))
2006	break;
2007
2008	gcc_assert (cond)((void)(!(cond) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2008, __FUNCTION__), 0 : 0));
2009	return cond;
2010	}
2011
2012	/* Assumed-shape arrays use a local variable for the array data;
2013	the actual PARAM_DECL is in a saved decl. As the local variable
2014	is NULL, it can be checked instead, unless use_saved_desc is
2015	requested. */
2016
2017	if (use_saved_desc && TREE_CODE (decl)((enum tree_code) (decl)->base.code) != PARM_DECL)
2018	{
2019	gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))((void)(!(((tree_class_check ((((contains_struct_check ((decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2019, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2019, __FUNCTION__))->type_common.lang_flag_1) \|\| ((tree_class_check ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2020, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2020, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2020, __FUNCTION__), 0 : 0))
2020	\|\| GFC_ARRAY_TYPE_P (TREE_TYPE (decl)))((void)(!(((tree_class_check ((((contains_struct_check ((decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2019, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2019, __FUNCTION__))->type_common.lang_flag_1) \|\| ((tree_class_check ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2020, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2020, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2020, __FUNCTION__), 0 : 0));
2021	decl = GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2021, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
2022	}
2023
2024	cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, decl,
2025	fold_convert (TREE_TYPE (decl), null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2025, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
2026
2027	/* Fortran 2008 allows to pass null pointers and non-associated pointers
2028	as actual argument to denote absent dummies. For array descriptors,
2029	we thus also need to check the array descriptor. For BT_CLASS, it
2030	can also occur for scalars and F2003 due to type->class wrapping and
2031	class->class wrapping. Note further that BT_CLASS always uses an
2032	array descriptor for arrays, also for explicit-shape/assumed-size.
2033	For assumed-rank arrays, no local variable is generated, hence,
2034	the following also applies with !use_saved_desc. */
2035
2036	if ((use_saved_desc \|\| TREE_CODE (orig_decl)((enum tree_code) (orig_decl)->base.code) == PARM_DECL)
2037	&& !sym->attr.allocatable
2038	&& ((sym->ts.type != BT_CLASS && !sym->attr.pointer)
2039	\|\| (sym->ts.type == BT_CLASS
2040	&& !CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable
2041	&& !CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer))
2042	&& ((gfc_option.allow_std & GFC_STD_F2008(1<<7)) != 0
2043	\|\| sym->ts.type == BT_CLASS))
2044	{
2045	tree tmp;
2046
2047	if ((sym->as && (sym->as->type == AS_ASSUMED_SHAPE
2048	\|\| sym->as->type == AS_ASSUMED_RANK
2049	\|\| sym->attr.codimension))
2050	\|\| (sym->ts.type == BT_CLASS && CLASS_DATA (sym)sym->ts.u.derived->components->as))
2051	{
2052	tmp = build_fold_indirect_ref_loc (input_location, decl);
2053	if (sym->ts.type == BT_CLASS)
2054	tmp = gfc_class_data_get (tmp);
2055	tmp = gfc_conv_array_data (tmp);
2056	}
2057	else if (sym->ts.type == BT_CLASS)
2058	tmp = gfc_class_data_get (decl);
2059	else
2060	tmp = NULL_TREE(tree) __null;
2061
2062	if (tmp != NULL_TREE(tree) __null)
2063	{
2064	tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
2065	fold_convert (TREE_TYPE (tmp), null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2065, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
2066	cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
2067	logical_type_node, cond, tmp);
2068	}
2069	}
2070
2071	return cond;
2072	}
2073
2074
2075	/* Converts a missing, dummy argument into a null or zero. */
2076
2077	void
2078	gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind)
2079	{
2080	tree present;
2081	tree tmp;
2082
2083	present = gfc_conv_expr_present (arg->symtree->n.sym);
2084
2085	if (kind > 0)
2086	{
2087	/* Create a temporary and convert it to the correct type. */
2088	tmp = gfc_get_int_type (kind);
2089	tmp = fold_convert (tmp, build_fold_indirect_ref_loc (input_location,fold_convert_loc (((location_t) 0), tmp, build_fold_indirect_ref_loc (input_location, se->expr))
2090	se->expr))fold_convert_loc (((location_t) 0), tmp, build_fold_indirect_ref_loc (input_location, se->expr));
2091
2092	/* Test for a NULL value. */
2093	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2093, __FUNCTION__))->typed.type), present,
2094	tmp, fold_convert (TREE_TYPE (tmp), integer_one_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2094, __FUNCTION__))->typed.type), global_trees[TI_INTEGER_ONE ]));
2095	tmp = gfc_evaluate_now (tmp, &se->pre);
2096	se->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
2097	}
2098	else
2099	{
2100	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (se->expr)((contains_struct_check ((se->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2100, __FUNCTION__))->typed.type),
2101	present, se->expr,
2102	build_zero_cst (TREE_TYPE (se->expr)((contains_struct_check ((se->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2102, __FUNCTION__))->typed.type)));
2103	tmp = gfc_evaluate_now (tmp, &se->pre);
2104	se->expr = tmp;
2105	}
2106
2107	if (ts.type == BT_CHARACTER)
2108	{
2109	tmp = build_int_cst (gfc_charlen_type_node, 0);
2110	tmp = fold_build3_loc (input_location, COND_EXPR, gfc_charlen_type_node,
2111	present, se->string_length, tmp);
2112	tmp = gfc_evaluate_now (tmp, &se->pre);
2113	se->string_length = tmp;
2114	}
2115	return;
2116	}
2117
2118
2119	/* Get the character length of an expression, looking through gfc_refs
2120	if necessary. */
2121
2122	tree
2123	gfc_get_expr_charlen (gfc_expr *e)
2124	{
2125	gfc_ref *r;
2126	tree length;
2127	gfc_se se;
2128
2129	gcc_assert (e->expr_type == EXPR_VARIABLE((void)(!(e->expr_type == EXPR_VARIABLE && e->ts .type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2130, __FUNCTION__), 0 : 0))
2130	&& e->ts.type == BT_CHARACTER)((void)(!(e->expr_type == EXPR_VARIABLE && e->ts .type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2130, __FUNCTION__), 0 : 0));
2131
2132	length = NULL__null; /* To silence compiler warning. */
2133
2134	if (is_subref_array (e) && e->ts.u.cl->length)
2135	{
2136	gfc_se tmpse;
2137	gfc_init_se (&tmpse, NULL__null);
2138	gfc_conv_expr_type (&tmpse, e->ts.u.cl->length, gfc_charlen_type_node);
2139	e->ts.u.cl->backend_decl = tmpse.expr;
2140	return tmpse.expr;
2141	}
2142
2143	/* First candidate: if the variable is of type CHARACTER, the
2144	expression's length could be the length of the character
2145	variable. */
2146	if (e->symtree->n.sym->ts.type == BT_CHARACTER)
2147	length = e->symtree->n.sym->ts.u.cl->backend_decl;
2148
2149	/* Look through the reference chain for component references. */
2150	for (r = e->ref; r; r = r->next)
2151	{
2152	switch (r->type)
2153	{
2154	case REF_COMPONENT:
2155	if (r->u.c.component->ts.type == BT_CHARACTER)
2156	length = r->u.c.component->ts.u.cl->backend_decl;
2157	break;
2158
2159	case REF_ARRAY:
2160	/* Do nothing. */
2161	break;
2162
2163	case REF_SUBSTRING:
2164	gfc_init_se (&se, NULL__null);
2165	gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node);
2166	length = se.expr;
2167	gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
2168	length = fold_build2_loc (input_location, MINUS_EXPR,
2169	gfc_charlen_type_node,
2170	se.expr, length);
2171	length = fold_build2_loc (input_location, PLUS_EXPR,
2172	gfc_charlen_type_node, length,
2173	gfc_index_one_nodegfc_rank_cst[1]);
2174	break;
2175
2176	default:
2177	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2177, __FUNCTION__));
2178	break;
2179	}
2180	}
2181
2182	gcc_assert (length != NULL)((void)(!(length != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2182, __FUNCTION__), 0 : 0));
2183	return length;
2184	}
2185
2186
2187	/* Return for an expression the backend decl of the coarray. */
2188
2189	tree
2190	gfc_get_tree_for_caf_expr (gfc_expr *expr)
2191	{
2192	tree caf_decl;
2193	bool found = false;
2194	gfc_ref *ref;
2195
2196	gcc_assert (expr && expr->expr_type == EXPR_VARIABLE)((void)(!(expr && expr->expr_type == EXPR_VARIABLE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2196, __FUNCTION__), 0 : 0));
2197
2198	/* Not-implemented diagnostic. */
2199	if (expr->symtree->n.sym->ts.type == BT_CLASS
2200	&& UNLIMITED_POLY (expr->symtree->n.sym)(expr->symtree->n.sym != __null && expr->symtree ->n.sym->ts.type == BT_CLASS && expr->symtree ->n.sym->ts.u.derived->components && expr-> symtree->n.sym->ts.u.derived->components->ts.u.derived && expr->symtree->n.sym->ts.u.derived->components ->ts.u.derived->attr.unlimited_polymorphic)
2201	&& CLASS_DATA (expr->symtree->n.sym)expr->symtree->n.sym->ts.u.derived->components->attr.codimension)
2202	gfc_error ("Sorry, coindexed access to an unlimited polymorphic object at "
2203	"%L is not supported", &expr->where);
2204
2205	for (ref = expr->ref; ref; ref = ref->next)
2206	if (ref->type == REF_COMPONENT)
2207	{
2208	if (ref->u.c.component->ts.type == BT_CLASS
2209	&& UNLIMITED_POLY (ref->u.c.component)(ref->u.c.component != __null && ref->u.c.component ->ts.type == BT_CLASS && ref->u.c.component-> ts.u.derived->components && ref->u.c.component-> ts.u.derived->components->ts.u.derived && ref-> u.c.component->ts.u.derived->components->ts.u.derived ->attr.unlimited_polymorphic)
2210	&& CLASS_DATA (ref->u.c.component)ref->u.c.component->ts.u.derived->components->attr.codimension)
2211	gfc_error ("Sorry, coindexed access to an unlimited polymorphic "
2212	"component at %L is not supported", &expr->where);
2213	}
2214
2215	/* Make sure the backend_decl is present before accessing it. */
2216	caf_decl = expr->symtree->n.sym->backend_decl == NULL_TREE(tree) __null
2217	? gfc_get_symbol_decl (expr->symtree->n.sym)
2218	: expr->symtree->n.sym->backend_decl;
2219
2220	if (expr->symtree->n.sym->ts.type == BT_CLASS)
2221	{
2222	if (expr->ref && expr->ref->type == REF_ARRAY)
2223	{
2224	caf_decl = gfc_class_data_get (caf_decl);
2225	if (CLASS_DATA (expr->symtree->n.sym)expr->symtree->n.sym->ts.u.derived->components->attr.codimension)
2226	return caf_decl;
2227	}
2228	for (ref = expr->ref; ref; ref = ref->next)
2229	{
2230	if (ref->type == REF_COMPONENT
2231	&& strcmp (ref->u.c.component->name, "_data") != 0)
2232	{
2233	caf_decl = gfc_class_data_get (caf_decl);
2234	if (CLASS_DATA (expr->symtree->n.sym)expr->symtree->n.sym->ts.u.derived->components->attr.codimension)
2235	return caf_decl;
2236	break;
2237	}
2238	else if (ref->type == REF_ARRAY && ref->u.ar.dimen)
2239	break;
2240	}
2241	}
2242	if (expr->symtree->n.sym->attr.codimension)
2243	return caf_decl;
2244
2245	/* The following code assumes that the coarray is a component reachable via
2246	only scalar components/variables; the Fortran standard guarantees this. */
2247
2248	for (ref = expr->ref; ref; ref = ref->next)
2249	if (ref->type == REF_COMPONENT)
2250	{
2251	gfc_component *comp = ref->u.c.component;
2252
2253	if (POINTER_TYPE_P (TREE_TYPE (caf_decl))(((enum tree_code) (((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2253, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((caf_decl), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2253, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
2254	caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
2255	caf_decl = fold_build3_loc (input_location, COMPONENT_REF,
2256	TREE_TYPE (comp->backend_decl)((contains_struct_check ((comp->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2256, __FUNCTION__))->typed.type), caf_decl,
2257	comp->backend_decl, NULL_TREE(tree) __null);
2258	if (comp->ts.type == BT_CLASS)
2259	{
2260	caf_decl = gfc_class_data_get (caf_decl);
2261	if (CLASS_DATA (comp)comp->ts.u.derived->components->attr.codimension)
2262	{
2263	found = true;
2264	break;
2265	}
2266	}
2267	if (comp->attr.codimension)
2268	{
2269	found = true;
2270	break;
2271	}
2272	}
2273	gcc_assert (found && caf_decl)((void)(!(found && caf_decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2273, __FUNCTION__), 0 : 0));
2274	return caf_decl;
2275	}
2276
2277
2278	/* Obtain the Coarray token - and optionally also the offset. */
2279
2280	void
2281	gfc_get_caf_token_offset (gfc_se se, tree token, tree *offset, tree caf_decl,
2282	tree se_expr, gfc_expr *expr)
2283	{
2284	tree tmp;
2285
2286	/* Coarray token. */
2287	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2287, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2287, __FUNCTION__))->type_common.lang_flag_1))
2288	{
2289	gcc_assert (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))((void)(!((((tree_class_check ((((contains_struct_check ((caf_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2289, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2289, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_ALLOCATABLE \|\| expr->symtree-> n.sym->attr.select_type_temporary) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2291, __FUNCTION__), 0 : 0))
2290	== GFC_ARRAY_ALLOCATABLE((void)(!((((tree_class_check ((((contains_struct_check ((caf_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2289, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2289, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_ALLOCATABLE \|\| expr->symtree-> n.sym->attr.select_type_temporary) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2291, __FUNCTION__), 0 : 0))
2291	\|\| expr->symtree->n.sym->attr.select_type_temporary)((void)(!((((tree_class_check ((((contains_struct_check ((caf_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2289, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2289, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_ALLOCATABLE \|\| expr->symtree-> n.sym->attr.select_type_temporary) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2291, __FUNCTION__), 0 : 0));
2292	*token = gfc_conv_descriptor_token (caf_decl);
2293	}
2294	else if (DECL_LANG_SPECIFIC (caf_decl)((contains_struct_check ((caf_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2294, __FUNCTION__))->decl_common.lang_specific)
2295	&& GFC_DECL_TOKEN (caf_decl)((contains_struct_check ((caf_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2295, __FUNCTION__))->decl_common.lang_specific)->token != NULL_TREE(tree) __null)
2296	*token = GFC_DECL_TOKEN (caf_decl)((contains_struct_check ((caf_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2296, __FUNCTION__))->decl_common.lang_specific)->token;
2297	else
2298	{
2299	gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (caf_decl))((void)(!(((tree_class_check ((((contains_struct_check ((caf_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2299, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2299, __FUNCTION__))->type_common.lang_flag_2) && (((tree_class_check ((((contains_struct_check ((caf_decl), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2300, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2300, __FUNCTION__))->type_with_lang_specific.lang_specific )->caf_token) != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2300, __FUNCTION__), 0 : 0))
2300	&& GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (caf_decl)) != NULL_TREE)((void)(!(((tree_class_check ((((contains_struct_check ((caf_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2299, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2299, __FUNCTION__))->type_common.lang_flag_2) && (((tree_class_check ((((contains_struct_check ((caf_decl), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2300, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2300, __FUNCTION__))->type_with_lang_specific.lang_specific )->caf_token) != (tree) __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2300, __FUNCTION__), 0 : 0));
2301	*token = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (caf_decl))(((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2301, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2301, __FUNCTION__))->type_with_lang_specific.lang_specific )->caf_token);
2302	}
2303
2304	if (offset == NULL__null)
2305	return;
2306
2307	/* Offset between the coarray base address and the address wanted. */
2308	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2308, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2308, __FUNCTION__))->type_common.lang_flag_1)
2309	&& (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))(((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2309, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2309, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_ALLOCATABLE
2310	\|\| GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))(((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2310, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2310, __FUNCTION__))->type_with_lang_specific.lang_specific )->akind) == GFC_ARRAY_POINTER))
2311	*offset = build_int_cst (gfc_array_index_type, 0);
2312	else if (DECL_LANG_SPECIFIC (caf_decl)((contains_struct_check ((caf_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2312, __FUNCTION__))->decl_common.lang_specific)
2313	&& GFC_DECL_CAF_OFFSET (caf_decl)((contains_struct_check ((caf_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2313, __FUNCTION__))->decl_common.lang_specific)->caf_offset != NULL_TREE(tree) __null)
2314	*offset = GFC_DECL_CAF_OFFSET (caf_decl)((contains_struct_check ((caf_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2314, __FUNCTION__))->decl_common.lang_specific)->caf_offset;
2315	else if (GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl))(((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2315, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2315, __FUNCTION__))->type_with_lang_specific.lang_specific )->caf_offset) != NULL_TREE(tree) __null)
2316	*offset = GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl))(((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2316, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2316, __FUNCTION__))->type_with_lang_specific.lang_specific )->caf_offset);
2317	else
2318	*offset = build_int_cst (gfc_array_index_type, 0);
2319
2320	if (POINTER_TYPE_P (TREE_TYPE (se_expr))(((enum tree_code) (((contains_struct_check ((se_expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2320, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((se_expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2320, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )
2321	&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se_expr)))((tree_class_check ((((contains_struct_check ((((contains_struct_check ((se_expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2321, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2321, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2321, __FUNCTION__))->type_common.lang_flag_1))
2322	{
2323	tmp = build_fold_indirect_ref_loc (input_location, se_expr);
2324	tmp = gfc_conv_descriptor_data_get (tmp);
2325	}
2326	else 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-expr.cc" , 2326, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2326, __FUNCTION__))->type_common.lang_flag_1))
2327	tmp = gfc_conv_descriptor_data_get (se_expr);
2328	else
2329	{
2330	gcc_assert (POINTER_TYPE_P (TREE_TYPE (se_expr)))((void)(!((((enum tree_code) (((contains_struct_check ((se_expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2330, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((se_expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2330, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2330, __FUNCTION__), 0 : 0));
2331	tmp = se_expr;
2332	}
2333
2334	*offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
2335	*offset, fold_convert (gfc_array_index_type, tmp)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmp ));
2336
2337	if (expr->symtree->n.sym->ts.type == BT_DERIVED
2338	&& expr->symtree->n.sym->attr.codimension
2339	&& expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)
2340	{
2341	gfc_expr *base_expr = gfc_copy_expr (expr);
2342	gfc_ref *ref = base_expr->ref;
2343	gfc_se base_se;
2344
2345	// Iterate through the refs until the last one.
2346	while (ref->next)
2347	ref = ref->next;
2348
2349	if (ref->type == REF_ARRAY
2350	&& ref->u.ar.type != AR_FULL)
2351	{
2352	const int ranksum = ref->u.ar.dimen + ref->u.ar.codimen;
2353	int i;
2354	for (i = 0; i < ranksum; ++i)
2355	{
2356	ref->u.ar.start[i] = NULL__null;
2357	ref->u.ar.end[i] = NULL__null;
2358	}
2359	ref->u.ar.type = AR_FULL;
2360	}
2361	gfc_init_se (&base_se, NULL__null);
2362	if (gfc_caf_attr (base_expr).dimension)
2363	{
2364	gfc_conv_expr_descriptor (&base_se, base_expr);
2365	tmp = gfc_conv_descriptor_data_get (base_se.expr);
2366	}
2367	else
2368	{
2369	gfc_conv_expr (&base_se, base_expr);
2370	tmp = base_se.expr;
2371	}
2372
2373	gfc_free_expr (base_expr);
2374	gfc_add_block_to_block (&se->pre, &base_se.pre);
2375	gfc_add_block_to_block (&se->post, &base_se.post);
2376	}
2377	else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))((tree_class_check ((((contains_struct_check ((caf_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2377, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2377, __FUNCTION__))->type_common.lang_flag_1))
2378	tmp = gfc_conv_descriptor_data_get (caf_decl);
2379	else
2380	{
2381	gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)))((void)(!((((enum tree_code) (((contains_struct_check ((caf_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2381, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((caf_decl), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2381, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2381, __FUNCTION__), 0 : 0));
2382	tmp = caf_decl;
2383	}
2384
2385	*offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
2386	fold_convert (gfc_array_index_type, offset)fold_convert_loc (((location_t) 0), gfc_array_index_type, offset ),
2387	fold_convert (gfc_array_index_type, tmp)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmp ));
2388	}
2389
2390
2391	/* Convert the coindex of a coarray into an image index; the result is
2392	image_num = (idx(1)-lcobound(1)+1) + (idx(2)-lcobound(2))*extent(1)
2393	+ (idx(3)-lcobound(3))extend(1)extent(2) + ... */
2394
2395	tree
2396	gfc_caf_get_image_index (stmtblock_t block, gfc_expr e, tree desc)
2397	{
2398	gfc_ref *ref;
2399	tree lbound, ubound, extent, tmp, img_idx;
2400	gfc_se se;
2401	int i;
2402
2403	for (ref = e->ref; ref; ref = ref->next)
2404	if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
2405	break;
2406	gcc_assert (ref != NULL)((void)(!(ref != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2406, __FUNCTION__), 0 : 0));
2407
2408	if (ref->u.ar.dimen_type[ref->u.ar.dimen] == DIMEN_THIS_IMAGE)
2409	{
2410	return build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
2411	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
2412	}
2413
2414	img_idx = build_zero_cst (gfc_array_index_type);
2415	extent = build_one_cst (gfc_array_index_type);
2416	if (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-expr.cc" , 2416, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2416, __FUNCTION__))->type_common.lang_flag_1))
2417	for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
2418	{
2419	gfc_init_se (&se, NULL__null);
2420	gfc_conv_expr_type (&se, ref->u.ar.start[i], gfc_array_index_type);
2421	gfc_add_block_to_block (block, &se.pre);
2422	lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
2423	tmp = fold_build2_loc (input_location, MINUS_EXPR,
2424	TREE_TYPE (lbound)((contains_struct_check ((lbound), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2424, __FUNCTION__))->typed.type), se.expr, lbound);
2425	tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2425, __FUNCTION__))->typed.type),
2426	extent, tmp);
2427	img_idx = fold_build2_loc (input_location, PLUS_EXPR,
2428	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2428, __FUNCTION__))->typed.type), img_idx, tmp);
2429	if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1)
2430	{
2431	ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
2432	tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL__null);
2433	extent = fold_build2_loc (input_location, MULT_EXPR,
2434	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2434, __FUNCTION__))->typed.type), extent, tmp);
2435	}
2436	}
2437	else
2438	for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
2439	{
2440	gfc_init_se (&se, NULL__null);
2441	gfc_conv_expr_type (&se, ref->u.ar.start[i], gfc_array_index_type);
2442	gfc_add_block_to_block (block, &se.pre);
2443	lbound = GFC_TYPE_ARRAY_LBOUND (TREE_TYPE (desc), i)(((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2443, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2443, __FUNCTION__))->type_with_lang_specific.lang_specific )->lbound[i]);
2444	tmp = fold_build2_loc (input_location, MINUS_EXPR,
2445	TREE_TYPE (lbound)((contains_struct_check ((lbound), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2445, __FUNCTION__))->typed.type), se.expr, lbound);
2446	tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2446, __FUNCTION__))->typed.type),
2447	extent, tmp);
2448	img_idx = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2448, __FUNCTION__))->typed.type),
2449	img_idx, tmp);
2450	if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1)
2451	{
2452	ubound = GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (desc), i)(((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2452, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2452, __FUNCTION__))->type_with_lang_specific.lang_specific )->ubound[i]);
2453	tmp = fold_build2_loc (input_location, MINUS_EXPR,
2454	TREE_TYPE (ubound)((contains_struct_check ((ubound), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2454, __FUNCTION__))->typed.type), ubound, lbound);
2455	tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2455, __FUNCTION__))->typed.type),
2456	tmp, build_one_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2456, __FUNCTION__))->typed.type)));
2457	extent = fold_build2_loc (input_location, MULT_EXPR,
2458	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2458, __FUNCTION__))->typed.type), extent, tmp);
2459	}
2460	}
2461	img_idx = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (img_idx)((contains_struct_check ((img_idx), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2461, __FUNCTION__))->typed.type),
2462	img_idx, build_one_cst (TREE_TYPE (img_idx)((contains_struct_check ((img_idx), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2462, __FUNCTION__))->typed.type)));
2463	return fold_convert (integer_type_node, img_idx)fold_convert_loc (((location_t) 0), integer_types[itk_int], img_idx );
2464	}
2465
2466
2467	/* For each character array constructor subexpression without a ts.u.cl->length,
2468	replace it by its first element (if there aren't any elements, the length
2469	should already be set to zero). */
2470
2471	static void
2472	flatten_array_ctors_without_strlen (gfc_expr* e)
2473	{
2474	gfc_actual_arglist* arg;
2475	gfc_constructor* c;
2476
2477	if (!e)
2478	return;
2479
2480	switch (e->expr_type)
2481	{
2482
2483	case EXPR_OP:
2484	flatten_array_ctors_without_strlen (e->value.op.op1);
2485	flatten_array_ctors_without_strlen (e->value.op.op2);
2486	break;
2487
2488	case EXPR_COMPCALL:
2489	/* TODO: Implement as with EXPR_FUNCTION when needed. */
2490	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2490, __FUNCTION__));
2491
2492	case EXPR_FUNCTION:
2493	for (arg = e->value.function.actual; arg; arg = arg->next)
2494	flatten_array_ctors_without_strlen (arg->expr);
2495	break;
2496
2497	case EXPR_ARRAY:
2498
2499	/* We've found what we're looking for. */
2500	if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
2501	{
2502	gfc_constructor *c;
2503	gfc_expr* new_expr;
2504
2505	gcc_assert (e->value.constructor)((void)(!(e->value.constructor) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2505, __FUNCTION__), 0 : 0));
2506
2507	c = gfc_constructor_first (e->value.constructor);
2508	new_expr = c->expr;
2509	c->expr = NULL__null;
2510
2511	flatten_array_ctors_without_strlen (new_expr);
2512	gfc_replace_expr (e, new_expr);
2513	break;
2514	}
2515
2516	/* Otherwise, fall through to handle constructor elements. */
2517	gcc_fallthrough ();
2518	case EXPR_STRUCTURE:
2519	for (c = gfc_constructor_first (e->value.constructor);
2520	c; c = gfc_constructor_next (c))
2521	flatten_array_ctors_without_strlen (c->expr);
2522	break;
2523
2524	default:
2525	break;
2526
2527	}
2528	}
2529
2530
2531	/* Generate code to initialize a string length variable. Returns the
2532	value. For array constructors, cl->length might be NULL and in this case,
2533	the first element of the constructor is needed. expr is the original
2534	expression so we can access it but can be NULL if this is not needed. */
2535
2536	void
2537	gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
2538	{
2539	gfc_se se;
2540
2541	gfc_init_se (&se, NULL__null);
2542
2543	if (!cl->length && cl->backend_decl && VAR_P (cl->backend_decl)(((enum tree_code) (cl->backend_decl)->base.code) == VAR_DECL ))
2544	return;
2545
2546	/* If cl->length is NULL, use gfc_conv_expr to obtain the string length but
2547	"flatten" array constructors by taking their first element; all elements
2548	should be the same length or a cl->length should be present. */
2549	if (!cl->length)
2550	{
2551	gfc_expr* expr_flat;
2552	if (!expr)
2553	return;
2554	expr_flat = gfc_copy_expr (expr);
2555	flatten_array_ctors_without_strlen (expr_flat);
2556	gfc_resolve_expr (expr_flat);
2557
2558	gfc_conv_expr (&se, expr_flat);
2559	gfc_add_block_to_block (pblock, &se.pre);
2560	cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
2561
2562	gfc_free_expr (expr_flat);
2563	return;
2564	}
2565
2566	/* Convert cl->length. */
2567
2568	gcc_assert (cl->length)((void)(!(cl->length) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2568, __FUNCTION__), 0 : 0));
2569
2570	gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
2571	se.expr = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node,
2572	se.expr, build_zero_cst (TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2572, __FUNCTION__))->typed.type)));
2573	gfc_add_block_to_block (pblock, &se.pre);
2574
2575	if (cl->backend_decl && VAR_P (cl->backend_decl)(((enum tree_code) (cl->backend_decl)->base.code) == VAR_DECL ))
2576	gfc_add_modify (pblock, cl->backend_decl, se.expr);
2577	else
2578	cl->backend_decl = gfc_evaluate_now (se.expr, pblock);
2579	}
2580
2581
2582	static void
2583	gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
2584	const char name, locus where)
2585	{
2586	tree tmp;
2587	tree type;
2588	tree fault;
2589	gfc_se start;
2590	gfc_se end;
2591	char *msg;
2592	mpz_t length;
2593
2594	type = gfc_get_character_type (kind, ref->u.ss.length);
2595	type = build_pointer_type (type);
2596
2597	gfc_init_se (&start, se);
2598	gfc_conv_expr_type (&start, ref->u.ss.start, gfc_charlen_type_node);
2599	gfc_add_block_to_block (&se->pre, &start.pre);
2600
2601	if (integer_onep (start.expr))
2602	gfc_conv_string_parameter (se);
2603	else
2604	{
2605	tmp = start.expr;
2606	STRIP_NOPS (tmp)(tmp) = tree_strip_nop_conversions ((const_cast<union tree_node *> (((tmp)))));
2607	/* Avoid multiple evaluation of substring start. */
2608	if (!CONSTANT_CLASS_P (tmp)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (tmp)->base.code))] == tcc_constant) && !DECL_P (tmp)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (tmp)->base.code))] == tcc_declaration))
2609	start.expr = gfc_evaluate_now (start.expr, &se->pre);
2610
2611	/* Change the start of the string. */
2612	if ((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-expr.cc" , 2612, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE
2613	\|\| 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-expr.cc" , 2613, __FUNCTION__))->typed.type))->base.code) == INTEGER_TYPE)
2614	&& TYPE_STRING_FLAG (TREE_TYPE (se->expr))((tree_check2 ((((contains_struct_check ((se->expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2614, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2614, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common .string_flag))
2615	tmp = se->expr;
2616	else
2617	tmp = build_fold_indirect_ref_loc (input_location,
2618	se->expr);
2619	/* For BIND(C), a BT_CHARACTER is not an ARRAY_TYPE. */
2620	if (TREE_CODE (TREE_TYPE (tmp))((enum tree_code) (((contains_struct_check ((tmp), (TS_TYPED) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2620, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE)
2621	{
2622	tmp = gfc_build_array_ref (tmp, start.expr, NULL_TREE(tree) __null, true);
2623	se->expr = gfc_build_addr_expr (type, tmp);
2624	}
2625	}
2626
2627	/* Length = end + 1 - start. */
2628	gfc_init_se (&end, se);
2629	if (ref->u.ss.end == NULL__null)
2630	end.expr = se->string_length;
2631	else
2632	{
2633	gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node);
2634	gfc_add_block_to_block (&se->pre, &end.pre);
2635	}
2636	tmp = end.expr;
2637	STRIP_NOPS (tmp)(tmp) = tree_strip_nop_conversions ((const_cast<union tree_node *> (((tmp)))));
2638	if (!CONSTANT_CLASS_P (tmp)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (tmp)->base.code))] == tcc_constant) && !DECL_P (tmp)(tree_code_type_tmpl <0>::tree_code_type[(int) (((enum tree_code ) (tmp)->base.code))] == tcc_declaration))
2639	end.expr = gfc_evaluate_now (end.expr, &se->pre);
2640
2641	if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
2642	&& (ref->u.ss.start->symtree
2643	&& !ref->u.ss.start->symtree->n.sym->attr.implied_index))
2644	{
2645	tree nonempty = fold_build2_loc (input_location, LE_EXPR,
2646	logical_type_node, start.expr,
2647	end.expr);
2648
2649	/* Check lower bound. */
2650	fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
2651	start.expr,
2652	build_one_cst (TREE_TYPE (start.expr)((contains_struct_check ((start.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2652, __FUNCTION__))->typed.type)));
2653	fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
2654	logical_type_node, nonempty, fault);
2655	if (name)
2656	msg = xasprintf ("Substring out of bounds: lower bound (%%ld) of '%s' "
2657	"is less than one", name);
2658	else
2659	msg = xasprintf ("Substring out of bounds: lower bound (%%ld) "
2660	"is less than one");
2661	gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
2662	fold_convert (long_integer_type_node,fold_convert_loc (((location_t) 0), integer_types[itk_long], start .expr)
2663	start.expr)fold_convert_loc (((location_t) 0), integer_types[itk_long], start .expr));
2664	free (msg);
2665
2666	/* Check upper bound. */
2667	fault = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
2668	end.expr, se->string_length);
2669	fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
2670	logical_type_node, nonempty, fault);
2671	if (name)
2672	msg = xasprintf ("Substring out of bounds: upper bound (%%ld) of '%s' "
2673	"exceeds string length (%%ld)", name);
2674	else
2675	msg = xasprintf ("Substring out of bounds: upper bound (%%ld) "
2676	"exceeds string length (%%ld)");
2677	gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
2678	fold_convert (long_integer_type_node, end.expr)fold_convert_loc (((location_t) 0), integer_types[itk_long], end .expr),
2679	fold_convert (long_integer_type_node,fold_convert_loc (((location_t) 0), integer_types[itk_long], se ->string_length)
2680	se->string_length)fold_convert_loc (((location_t) 0), integer_types[itk_long], se ->string_length));
2681	free (msg);
2682	}
2683
2684	/* Try to calculate the length from the start and end expressions. */
2685	if (ref->u.ss.end
2686	&& gfc_dep_difference (ref->u.ss.end, ref->u.ss.start, &length))
2687	{
2688	HOST_WIDE_INTlong i_len;
2689
2690	i_len = gfc_mpz_get_hwi (length) + 1;
2691	if (i_len < 0)
2692	i_len = 0;
2693
2694	tmp = build_int_cst (gfc_charlen_type_node, i_len);
2695	mpz_clear__gmpz_clear (length); /* Was initialized by gfc_dep_difference. */
2696	}
2697	else
2698	{
2699	tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
2700	fold_convert (gfc_charlen_type_node, end.expr)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, end .expr),
2701	fold_convert (gfc_charlen_type_node, start.expr)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, start .expr));
2702	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_charlen_type_node,
2703	build_int_cst (gfc_charlen_type_node, 1), tmp);
2704	tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node,
2705	tmp, build_int_cst (gfc_charlen_type_node, 0));
2706	}
2707
2708	se->string_length = tmp;
2709	}
2710
2711
2712	/* Convert a derived type component reference. */
2713
2714	void
2715	gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
2716	{
2717	gfc_component *c;
2718	tree tmp;
2719	tree decl;
2720	tree field;
2721	tree context;
2722
2723	c = ref->u.c.component;
2724
2725	if (c->backend_decl == NULL_TREE(tree) __null
2726	&& ref->u.c.sym != NULL__null)
2727	gfc_get_derived_type (ref->u.c.sym);
2728
2729	field = c->backend_decl;
2730	gcc_assert (field && TREE_CODE (field) == FIELD_DECL)((void)(!(field && ((enum tree_code) (field)->base .code) == FIELD_DECL) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2730, __FUNCTION__), 0 : 0));
2731	decl = se->expr;
2732	context = DECL_FIELD_CONTEXT (field)((tree_check ((field), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2732, __FUNCTION__, (FIELD_DECL)))->decl_minimal.context );
2733
2734	/* Components can correspond to fields of different containing
2735	types, as components are created without context, whereas
2736	a concrete use of a component has the type of decl as context.
2737	So, if the type doesn't match, we search the corresponding
2738	FIELD_DECL in the parent type. To not waste too much time
2739	we cache this result in norestrict_decl.
2740	On the other hand, if the context is a UNION or a MAP (a
2741	RECORD_TYPE within a UNION_TYPE) always use the given FIELD_DECL. */
2742
2743	if (context != TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2743, __FUNCTION__))->typed.type)
2744	&& !( TREE_CODE (TREE_TYPE (field))((enum tree_code) (((contains_struct_check ((field), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2744, __FUNCTION__))->typed.type))->base.code) == UNION_TYPE /* Field is union */
2745	\|\| TREE_CODE (context)((enum tree_code) (context)->base.code) == UNION_TYPE)) /* Field is map */
2746	{
2747	tree f2 = c->norestrict_decl;
2748	if (!f2 \|\| DECL_FIELD_CONTEXT (f2)((tree_check ((f2), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2748, __FUNCTION__, (FIELD_DECL)))->decl_minimal.context ) != TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2748, __FUNCTION__))->typed.type))
2749	for (f2 = TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2749, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2749, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE )))->type_non_common.values); f2; f2 = DECL_CHAIN (f2)(((contains_struct_check (((contains_struct_check ((f2), (TS_DECL_MINIMAL ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2749, __FUNCTION__))), (TS_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2749, __FUNCTION__))->common.chain)))
2750	if (TREE_CODE (f2)((enum tree_code) (f2)->base.code) == FIELD_DECL
2751	&& DECL_NAME (f2)((contains_struct_check ((f2), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2751, __FUNCTION__))->decl_minimal.name) == DECL_NAME (field)((contains_struct_check ((field), (TS_DECL_MINIMAL), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2751, __FUNCTION__))->decl_minimal.name))
2752	break;
2753	gcc_assert (f2)((void)(!(f2) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2753, __FUNCTION__), 0 : 0));
2754	c->norestrict_decl = f2;
2755	field = f2;
2756	}
2757
2758	if (ref->u.c.sym && ref->u.c.sym->ts.type == BT_CLASS
2759	&& strcmp ("_data", c->name) == 0)
2760	{
2761	/* Found a ref to the _data component. Store the associated ref to
2762	the vptr in se->class_vptr. */
2763	se->class_vptr = gfc_class_vptr_get (decl);
2764	}
2765	else
2766	se->class_vptr = NULL_TREE(tree) __null;
2767
2768	tmp = 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-expr.cc" , 2768, __FUNCTION__))->typed.type),
2769	decl, field, NULL_TREE(tree) __null);
2770
2771	se->expr = tmp;
2772
2773	/* Allocatable deferred char arrays are to be handled by the gfc_deferred_
2774	strlen () conditional below. */
2775	if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer
2776	&& !c->ts.deferred
2777	&& !c->attr.pdt_string)
2778	{
2779	tmp = c->ts.u.cl->backend_decl;
2780	/* Components must always be constant length. */
2781	gcc_assert (tmp && INTEGER_CST_P (tmp))((void)(!(tmp && (((enum tree_code) (tmp)->base.code ) == INTEGER_CST)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2781, __FUNCTION__), 0 : 0));
2782	se->string_length = tmp;
2783	}
2784
2785	if (gfc_deferred_strlen (c, &field))
2786	{
2787	tmp = fold_build3_loc (input_location, COMPONENT_REF,
2788	TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2788, __FUNCTION__))->typed.type),
2789	decl, field, NULL_TREE(tree) __null);
2790	se->string_length = tmp;
2791	}
2792
2793	if (((c->attr.pointer \|\| c->attr.allocatable)
2794	&& (!c->attr.dimension && !c->attr.codimension)
2795	&& c->ts.type != BT_CHARACTER)
2796	\|\| c->attr.proc_pointer)
2797	se->expr = build_fold_indirect_ref_loc (input_location,
2798	se->expr);
2799	}
2800
2801
2802	/* This function deals with component references to components of the
2803	parent type for derived type extensions. */
2804	void
2805	conv_parent_component_references (gfc_se * se, gfc_ref * ref)
2806	{
2807	gfc_component *c;
2808	gfc_component *cmp;
2809	gfc_symbol *dt;
2810	gfc_ref parent;
2811
2812	dt = ref->u.c.sym;
2813	c = ref->u.c.component;
2814
2815	/* Return if the component is in this type, i.e. not in the parent type. */
2816	for (cmp = dt->components; cmp; cmp = cmp->next)
2817	if (c == cmp)
2818	return;
2819
2820	/* Build a gfc_ref to recursively call gfc_conv_component_ref. */
2821	parent.type = REF_COMPONENT;
2822	parent.next = NULL__null;
2823	parent.u.c.sym = dt;
2824	parent.u.c.component = dt->components;
2825
2826	if (dt->backend_decl == NULL__null)
2827	gfc_get_derived_type (dt);
2828
2829	/* Build the reference and call self. */
2830	gfc_conv_component_ref (se, &parent);
2831	parent.u.c.sym = dt->components->ts.u.derived;
2832	parent.u.c.component = c;
2833	conv_parent_component_references (se, &parent);
2834	}
2835
2836
2837	static void
2838	conv_inquiry (gfc_se * se, gfc_ref * ref, gfc_expr expr, gfc_typespec ts)
2839	{
2840	tree res = se->expr;
2841
2842	switch (ref->u.i)
2843	{
2844	case INQUIRY_RE:
2845	res = fold_build1_loc (input_location, REALPART_EXPR,
2846	TREE_TYPE (TREE_TYPE (res))((contains_struct_check ((((contains_struct_check ((res), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2846, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2846, __FUNCTION__))->typed.type), res);
2847	break;
2848
2849	case INQUIRY_IM:
2850	res = fold_build1_loc (input_location, IMAGPART_EXPR,
2851	TREE_TYPE (TREE_TYPE (res))((contains_struct_check ((((contains_struct_check ((res), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2851, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2851, __FUNCTION__))->typed.type), res);
2852	break;
2853
2854	case INQUIRY_KIND:
2855	res = build_int_cst (gfc_typenode_for_spec (&expr->ts),
2856	ts->kind);
2857	break;
2858
2859	case INQUIRY_LEN:
2860	res = fold_convert (gfc_typenode_for_spec (&expr->ts),fold_convert_loc (((location_t) 0), gfc_typenode_for_spec (& expr->ts), se->string_length)
2861	se->string_length)fold_convert_loc (((location_t) 0), gfc_typenode_for_spec (& expr->ts), se->string_length);
2862	break;
2863
2864	default:
2865	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2865, __FUNCTION__));
2866	}
2867	se->expr = res;
2868	}
2869
2870	/* Dereference VAR where needed if it is a pointer, reference, etc.
2871	according to Fortran semantics. */
2872
2873	tree
2874	gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p,
2875	bool is_classarray)
2876	{
2877	if (!POINTER_TYPE_P (TREE_TYPE (var))(((enum tree_code) (((contains_struct_check ((var), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2877, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((var), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2877, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
2878	return var;
2879	if (is_CFI_desc (sym, NULL__null))
2880	return build_fold_indirect_ref_loc (input_location, var);
2881
2882	/* Characters are entirely different from other types, they are treated
2883	separately. */
2884	if (sym->ts.type == BT_CHARACTER)
2885	{
2886	/* Dereference character pointer dummy arguments
2887	or results. */
2888	if ((sym->attr.pointer \|\| sym->attr.allocatable
2889	\|\| (sym->as && sym->as->type == AS_ASSUMED_RANK))
2890	&& (sym->attr.dummy
2891	\|\| sym->attr.function
2892	\|\| sym->attr.result))
2893	var = build_fold_indirect_ref_loc (input_location, var);
2894	}
2895	else if (!sym->attr.value)
2896	{
2897	/* Dereference temporaries for class array dummy arguments. */
2898	if (sym->attr.dummy && is_classarray
2899	&& GFC_ARRAY_TYPE_P (TREE_TYPE (var))((tree_class_check ((((contains_struct_check ((var), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2899, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2899, __FUNCTION__))->type_common.lang_flag_2))
2900	{
2901	if (!descriptor_only_p)
2902	var = GFC_DECL_SAVED_DESCRIPTOR (var)(((contains_struct_check ((var), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2902, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
2903
2904	var = build_fold_indirect_ref_loc (input_location, var);
2905	}
2906
2907	/* Dereference non-character scalar dummy arguments. */
2908	if (sym->attr.dummy && !sym->attr.dimension
2909	&& !(sym->attr.codimension && sym->attr.allocatable)
2910	&& (sym->ts.type != BT_CLASS
2911	\|\| (!CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
2912	&& !(CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension
2913	&& CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable))))
2914	var = build_fold_indirect_ref_loc (input_location, var);
2915
2916	/* Dereference scalar hidden result. */
2917	if (flag_f2cglobal_options.x_flag_f2c && sym->ts.type == BT_COMPLEX
2918	&& (sym->attr.function \|\| sym->attr.result)
2919	&& !sym->attr.dimension && !sym->attr.pointer
2920	&& !sym->attr.always_explicit)
2921	var = build_fold_indirect_ref_loc (input_location, var);
2922
2923	/* Dereference non-character, non-class pointer variables.
2924	These must be dummies, results, or scalars. */
2925	if (!is_classarray
2926	&& (sym->attr.pointer \|\| sym->attr.allocatable
2927	\|\| gfc_is_associate_pointer (sym)
2928	\|\| (sym->as && sym->as->type == AS_ASSUMED_RANK))
2929	&& (sym->attr.dummy
2930	\|\| sym->attr.function
2931	\|\| sym->attr.result
2932	\|\| (!sym->attr.dimension
2933	&& (!sym->attr.codimension \|\| !sym->attr.allocatable))))
2934	var = build_fold_indirect_ref_loc (input_location, var);
2935	/* Now treat the class array pointer variables accordingly. */
2936	else if (sym->ts.type == BT_CLASS
2937	&& sym->attr.dummy
2938	&& (CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
2939	\|\| CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension)
2940	&& ((CLASS_DATA (sym)sym->ts.u.derived->components->as
2941	&& CLASS_DATA (sym)sym->ts.u.derived->components->as->type == AS_ASSUMED_RANK)
2942	\|\| CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable
2943	\|\| CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer))
2944	var = build_fold_indirect_ref_loc (input_location, var);
2945	/* And the case where a non-dummy, non-result, non-function,
2946	non-allocable and non-pointer classarray is present. This case was
2947	previously covered by the first if, but with introducing the
2948	condition !is_classarray there, that case has to be covered
2949	explicitly. */
2950	else if (sym->ts.type == BT_CLASS
2951	&& !sym->attr.dummy
2952	&& !sym->attr.function
2953	&& !sym->attr.result
2954	&& (CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
2955	\|\| CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension)
2956	&& (sym->assoc
2957	\|\| !CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable)
2958	&& !CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer)
2959	var = build_fold_indirect_ref_loc (input_location, var);
2960	}
2961
2962	return var;
2963	}
2964
2965	/* Return the contents of a variable. Also handles reference/pointer
2966	variables (all Fortran pointer references are implicit). */
2967
2968	static void
2969	gfc_conv_variable (gfc_se * se, gfc_expr * expr)
2970	{
2971	gfc_ss *ss;
2972	gfc_ref *ref;
2973	gfc_symbol *sym;
2974	tree parent_decl = NULL_TREE(tree) __null;
2975	int parent_flag;
2976	bool return_value;
2977	bool alternate_entry;
2978	bool entry_master;
2979	bool is_classarray;
2980	bool first_time = true;
2981
2982	sym = expr->symtree->n.sym;
2983	is_classarray = IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived-> components && sym->ts.u.derived->components-> attr.dimension && !sym->ts.u.derived->components ->attr.class_pointer);
2984	ss = se->ss;
2985	if (ss != NULL__null)
2986	{
2987	gfc_ss_info *ss_info = ss->info;
2988
2989	/* Check that something hasn't gone horribly wrong. */
2990	gcc_assert (ss != gfc_ss_terminator)((void)(!(ss != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2990, __FUNCTION__), 0 : 0));
2991	gcc_assert (ss_info->expr == expr)((void)(!(ss_info->expr == expr) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2991, __FUNCTION__), 0 : 0));
2992
2993	/* A scalarized term. We already know the descriptor. */
2994	se->expr = ss_info->data.array.descriptor;
2995	se->string_length = ss_info->string_length;
2996	ref = ss_info->data.array.ref;
2997	if (ref)
2998	gcc_assert (ref->type == REF_ARRAY((void)(!(ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2999, __FUNCTION__), 0 : 0))
2999	&& ref->u.ar.type != AR_ELEMENT)((void)(!(ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 2999, __FUNCTION__), 0 : 0));
3000	else
3001	gfc_conv_tmp_array_ref (se);
3002	}
3003	else
3004	{
3005	tree se_expr = NULL_TREE(tree) __null;
3006
3007	se->expr = gfc_get_symbol_decl (sym);
3008
3009	/* Deal with references to a parent results or entries by storing
3010	the current_function_decl and moving to the parent_decl. */
3011	return_value = sym->attr.function && sym->result == sym;
3012	alternate_entry = sym->attr.function && sym->attr.entry
3013	&& sym->result == sym;
3014	entry_master = sym->attr.result
3015	&& sym->ns->proc_name->attr.entry_master
3016	&& !gfc_return_by_reference (sym->ns->proc_name);
3017	if (current_function_decl)
3018	parent_decl = DECL_CONTEXT (current_function_decl)((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3018, __FUNCTION__))->decl_minimal.context);
3019
3020	if ((se->expr == parent_decl && return_value)
3021	\|\| (sym->ns && sym->ns->proc_name
3022	&& parent_decl
3023	&& sym->ns->proc_name->backend_decl == parent_decl
3024	&& (alternate_entry \|\| entry_master)))
3025	parent_flag = 1;
3026	else
3027	parent_flag = 0;
3028
3029	/* Special case for assigning the return value of a function.
3030	Self recursive functions must have an explicit return value. */
3031	if (return_value && (se->expr == current_function_decl \|\| parent_flag))
3032	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
3033
3034	/* Similarly for alternate entry points. */
3035	else if (alternate_entry
3036	&& (sym->ns->proc_name->backend_decl == current_function_decl
3037	\|\| parent_flag))
3038	{
3039	gfc_entry_list *el = NULL__null;
3040
3041	for (el = sym->ns->entries; el; el = el->next)
3042	if (sym == el->sym)
3043	{
3044	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
3045	break;
3046	}
3047	}
3048
3049	else if (entry_master
3050	&& (sym->ns->proc_name->backend_decl == current_function_decl
3051	\|\| parent_flag))
3052	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
3053
3054	if (se_expr)
3055	se->expr = se_expr;
3056
3057	/* Procedure actual arguments. Look out for temporary variables
3058	with the same attributes as function values. */
3059	else if (!sym->attr.temporary
3060	&& sym->attr.flavor == FL_PROCEDURE
3061	&& se->expr != current_function_decl)
3062	{
3063	if (!sym->attr.dummy && !sym->attr.proc_pointer)
3064	{
3065	gcc_assert (TREE_CODE (se->expr) == FUNCTION_DECL)((void)(!(((enum tree_code) (se->expr)->base.code) == FUNCTION_DECL ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3065, __FUNCTION__), 0 : 0));
3066	se->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, se->expr);
3067	}
3068	return;
3069	}
3070
3071	/* Dereference the expression, where needed. */
3072	se->expr = gfc_maybe_dereference_var (sym, se->expr, se->descriptor_only,
3073	is_classarray);
3074
3075	ref = expr->ref;
3076	}
3077
3078	/* For character variables, also get the length. */
3079	if (sym->ts.type == BT_CHARACTER)
3080	{
3081	/* If the character length of an entry isn't set, get the length from
3082	the master function instead. */
3083	if (sym->attr.entry && !sym->ts.u.cl->backend_decl)
3084	se->string_length = sym->ns->proc_name->ts.u.cl->backend_decl;
3085	else
3086	se->string_length = sym->ts.u.cl->backend_decl;
3087	gcc_assert (se->string_length)((void)(!(se->string_length) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3087, __FUNCTION__), 0 : 0));
3088	}
3089
3090	gfc_typespec *ts = &sym->ts;
3091	while (ref)
3092	{
3093	switch (ref->type)
3094	{
3095	case REF_ARRAY:
3096	/* Return the descriptor if that's what we want and this is an array
3097	section reference. */
3098	if (se->descriptor_only && ref->u.ar.type != AR_ELEMENT)
3099	return;
3100	/* TODO: Pointers to single elements of array sections, eg elemental subs. */
3101	/* Return the descriptor for array pointers and allocations. */
3102	if (se->want_pointer
3103	&& ref->next == NULL__null && (se->descriptor_only))
3104	return;
3105
3106	gfc_conv_array_ref (se, &ref->u.ar, expr, &expr->where);
3107	/* Return a pointer to an element. */
3108	break;
3109
3110	case REF_COMPONENT:
3111	ts = &ref->u.c.component->ts;
3112	if (first_time && is_classarray && sym->attr.dummy
3113	&& se->descriptor_only
3114	&& !CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable
3115	&& !CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer
3116	&& CLASS_DATA (sym)sym->ts.u.derived->components->as
3117	&& CLASS_DATA (sym)sym->ts.u.derived->components->as->type != AS_ASSUMED_RANK
3118	&& strcmp ("_data", ref->u.c.component->name) == 0)
3119	/* Skip the first ref of a _data component, because for class
3120	arrays that one is already done by introducing a temporary
3121	array descriptor. */
3122	break;
3123
3124	if (ref->u.c.sym->attr.extension)
3125	conv_parent_component_references (se, ref);
3126
3127	gfc_conv_component_ref (se, ref);
3128	if (!ref->next && ref->u.c.sym->attr.codimension
3129	&& se->want_pointer && se->descriptor_only)
3130	return;
3131
3132	break;
3133
3134	case REF_SUBSTRING:
3135	gfc_conv_substring (se, ref, expr->ts.kind,
3136	expr->symtree->name, &expr->where);
3137	break;
3138
3139	case REF_INQUIRY:
3140	conv_inquiry (se, ref, expr, ts);
3141	break;
3142
3143	default:
3144	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3144, __FUNCTION__));
3145	break;
3146	}
3147	first_time = false;
3148	ref = ref->next;
3149	}
3150	/* Pointer assignment, allocation or pass by reference. Arrays are handled
3151	separately. */
3152	if (se->want_pointer)
3153	{
3154	if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr))
3155	gfc_conv_string_parameter (se);
3156	else
3157	se->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, se->expr);
3158	}
3159	}
3160
3161
3162	/* Unary ops are easy... Or they would be if ! was a valid op. */
3163
3164	static void
3165	gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr)
3166	{
3167	gfc_se operand;
3168	tree type;
3169
3170	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-expr.cc" , 3170, __FUNCTION__), 0 : 0));
3171	/* Initialize the operand. */
3172	gfc_init_se (&operand, se);
3173	gfc_conv_expr_val (&operand, expr->value.op.op1);
3174	gfc_add_block_to_block (&se->pre, &operand.pre);
3175
3176	type = gfc_typenode_for_spec (&expr->ts);
3177
3178	/* TRUTH_NOT_EXPR is not a "true" unary operator in GCC.
3179	We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)).
3180	All other unary operators have an equivalent GIMPLE unary operator. */
3181	if (code == TRUTH_NOT_EXPR)
3182	se->expr = fold_build2_loc (input_location, EQ_EXPR, type, operand.expr,
3183	build_int_cst (type, 0));
3184	else
3185	se->expr = fold_build1_loc (input_location, code, type, operand.expr);
3186
3187	}
3188
3189	/* Expand power operator to optimal multiplications when a value is raised
3190	to a constant integer n. See section 4.6.3, "Evaluation of Powers" of
3191	Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer
3192	Programming", 3rd Edition, 1998. */
3193
3194	/* This code is mostly duplicated from expand_powi in the backend.
3195	We establish the "optimal power tree" lookup table with the defined size.
3196	The items in the table are the exponents used to calculate the index
3197	exponents. Any integer n less than the value can get an "addition chain",
3198	with the first node being one. */
3199	#define POWI_TABLE_SIZE256 256
3200
3201	/* The table is from builtins.cc. */
3202	static const unsigned char powi_table[POWI_TABLE_SIZE256] =
3203	{
3204	0, 1, 1, 2, 2, 3, 3, 4, /* 0 - 7 */
3205	4, 6, 5, 6, 6, 10, 7, 9, /* 8 - 15 */
3206	8, 16, 9, 16, 10, 12, 11, 13, /* 16 - 23 */
3207	12, 17, 13, 18, 14, 24, 15, 26, /* 24 - 31 */
3208	16, 17, 17, 19, 18, 33, 19, 26, /* 32 - 39 */
3209	20, 25, 21, 40, 22, 27, 23, 44, /* 40 - 47 */
3210	24, 32, 25, 34, 26, 29, 27, 44, /* 48 - 55 */
3211	28, 31, 29, 34, 30, 60, 31, 36, /* 56 - 63 */
3212	32, 64, 33, 34, 34, 46, 35, 37, /* 64 - 71 */
3213	36, 65, 37, 50, 38, 48, 39, 69, /* 72 - 79 */
3214	40, 49, 41, 43, 42, 51, 43, 58, /* 80 - 87 */
3215	44, 64, 45, 47, 46, 59, 47, 76, /* 88 - 95 */
3216	48, 65, 49, 66, 50, 67, 51, 66, /* 96 - 103 */
3217	52, 70, 53, 74, 54, 104, 55, 74, /* 104 - 111 */
3218	56, 64, 57, 69, 58, 78, 59, 68, /* 112 - 119 */
3219	60, 61, 61, 80, 62, 75, 63, 68, /* 120 - 127 */
3220	64, 65, 65, 128, 66, 129, 67, 90, /* 128 - 135 */
3221	68, 73, 69, 131, 70, 94, 71, 88, /* 136 - 143 */
3222	72, 128, 73, 98, 74, 132, 75, 121, /* 144 - 151 */
3223	76, 102, 77, 124, 78, 132, 79, 106, /* 152 - 159 */
3224	80, 97, 81, 160, 82, 99, 83, 134, /* 160 - 167 */
3225	84, 86, 85, 95, 86, 160, 87, 100, /* 168 - 175 */
3226	88, 113, 89, 98, 90, 107, 91, 122, /* 176 - 183 */
3227	92, 111, 93, 102, 94, 126, 95, 150, /* 184 - 191 */
3228	96, 128, 97, 130, 98, 133, 99, 195, /* 192 - 199 */
3229	100, 128, 101, 123, 102, 164, 103, 138, /* 200 - 207 */
3230	104, 145, 105, 146, 106, 109, 107, 149, /* 208 - 215 */
3231	108, 200, 109, 146, 110, 170, 111, 157, /* 216 - 223 */
3232	112, 128, 113, 130, 114, 182, 115, 132, /* 224 - 231 */
3233	116, 200, 117, 132, 118, 158, 119, 206, /* 232 - 239 */
3234	120, 240, 121, 162, 122, 147, 123, 152, /* 240 - 247 */
3235	124, 166, 125, 214, 126, 138, 127, 153, /* 248 - 255 */
3236	};
3237
3238	/* If n is larger than lookup table's max index, we use the "window
3239	method". */
3240	#define POWI_WINDOW_SIZE3 3
3241
3242	/* Recursive function to expand the power operator. The temporary
3243	values are put in tmpvar. The function returns tmpvar[1] ** n. */
3244	static tree
3245	gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INTlong n, tree * tmpvar)
3246	{
3247	tree op0;
3248	tree op1;
3249	tree tmp;
3250	int digit;
3251
3252	if (n < POWI_TABLE_SIZE256)
3253	{
3254	if (tmpvar[n])
3255	return tmpvar[n];
3256
3257	op0 = gfc_conv_powi (se, n - powi_table[n], tmpvar);
3258	op1 = gfc_conv_powi (se, powi_table[n], tmpvar);
3259	}
3260	else if (n & 1)
3261	{
3262	digit = n & ((1 << POWI_WINDOW_SIZE3) - 1);
3263	op0 = gfc_conv_powi (se, n - digit, tmpvar);
3264	op1 = gfc_conv_powi (se, digit, tmpvar);
3265	}
3266	else
3267	{
3268	op0 = gfc_conv_powi (se, n >> 1, tmpvar);
3269	op1 = op0;
3270	}
3271
3272	tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (op0)((contains_struct_check ((op0), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3272, __FUNCTION__))->typed.type), op0, op1);
3273	tmp = gfc_evaluate_now (tmp, &se->pre);
3274
3275	if (n < POWI_TABLE_SIZE256)
3276	tmpvar[n] = tmp;
3277
3278	return tmp;
3279	}
3280
3281
3282	/* Expand lhs ** rhs. rhs is a constant integer. If it expands successfully,
3283	return 1. Else return 0 and a call to runtime library functions
3284	will have to be built. */
3285	static int
3286	gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
3287	{
3288	tree cond;
3289	tree tmp;
3290	tree type;
3291	tree vartmp[POWI_TABLE_SIZE256];
3292	HOST_WIDE_INTlong m;
3293	unsigned HOST_WIDE_INTlong n;
3294	int sgn;
3295	wi::tree_to_wide_ref wrhs = wi::to_wide (rhs);
3296
3297	/* If exponent is too large, we won't expand it anyway, so don't bother
3298	with large integer values. */
3299	if (!wi::fits_shwi_p (wrhs))
3300	return 0;
3301
3302	m = wrhs.to_shwi ();
3303	/* Use the wide_int's routine to reliably get the absolute value on all
3304	platforms. Then convert it to a HOST_WIDE_INT like above. */
3305	n = wi::abs (wrhs).to_shwi ();
3306
3307	type = TREE_TYPE (lhs)((contains_struct_check ((lhs), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3307, __FUNCTION__))->typed.type);
3308	sgn = tree_int_cst_sgn (rhs);
3309
3310	if (((FLOAT_TYPE_P (type)((((enum tree_code) (type)->base.code) == REAL_TYPE) \|\| (( ((enum tree_code) (type)->base.code) == COMPLEX_TYPE \|\| (( (enum tree_code) (type)->base.code) == VECTOR_TYPE)) && (((enum tree_code) (((contains_struct_check ((type), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3310, __FUNCTION__))->typed.type))->base.code) == REAL_TYPE ))) && !flag_unsafe_math_optimizationsglobal_options.x_flag_unsafe_math_optimizations)
3311	\|\| optimize_sizeglobal_options.x_optimize_size) && (m > 2 \|\| m < -1))
3312	return 0;
3313
3314	/* rhs == 0 */
3315	if (sgn == 0)
3316	{
3317	se->expr = gfc_build_const (type, integer_one_nodeglobal_trees[TI_INTEGER_ONE]);
3318	return 1;
3319	}
3320
3321	/* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */
3322	if ((sgn == -1) && (TREE_CODE (type)((enum tree_code) (type)->base.code) == INTEGER_TYPE))
3323	{
3324	tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
3325	lhs, build_int_cst (TREE_TYPE (lhs)((contains_struct_check ((lhs), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3325, __FUNCTION__))->typed.type), -1));
3326	cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
3327	lhs, build_int_cst (TREE_TYPE (lhs)((contains_struct_check ((lhs), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3327, __FUNCTION__))->typed.type), 1));
3328
3329	/* If rhs is even,
3330	result = (lhs == 1 \|\| lhs == -1) ? 1 : 0. */
3331	if ((n & 1) == 0)
3332	{
3333	tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR,
3334	logical_type_node, tmp, cond);
3335	se->expr = fold_build3_loc (input_location, COND_EXPR, type,
3336	tmp, build_int_cst (type, 1),
3337	build_int_cst (type, 0));
3338	return 1;
3339	}
3340	/* If rhs is odd,
3341	result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0. */
3342	tmp = fold_build3_loc (input_location, COND_EXPR, type, tmp,
3343	build_int_cst (type, -1),
3344	build_int_cst (type, 0));
3345	se->expr = fold_build3_loc (input_location, COND_EXPR, type,
3346	cond, build_int_cst (type, 1), tmp);
3347	return 1;
3348	}
3349
3350	memset (vartmp, 0, sizeof (vartmp));
3351	vartmp[1] = lhs;
3352	if (sgn == -1)
3353	{
3354	tmp = gfc_build_const (type, integer_one_nodeglobal_trees[TI_INTEGER_ONE]);
3355	vartmp[1] = fold_build2_loc (input_location, RDIV_EXPR, type, tmp,
3356	vartmp[1]);
3357	}
3358
3359	se->expr = gfc_conv_powi (se, n, vartmp);
3360
3361	return 1;
3362	}
3363
3364
3365	/* Power op (*). Constant integer exponent has special handling. /
3366
3367	static void
3368	gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
3369	{
3370	tree gfc_int4_type_node;
3371	int kind;
3372	int ikind;
3373	int res_ikind_1, res_ikind_2;
3374	gfc_se lse;
3375	gfc_se rse;
3376	tree fndecl = NULL__null;
3377
3378	gfc_init_se (&lse, se);
3379	gfc_conv_expr_val (&lse, expr->value.op.op1);
3380	lse.expr = gfc_evaluate_now (lse.expr, &lse.pre);
3381	gfc_add_block_to_block (&se->pre, &lse.pre);
3382
3383	gfc_init_se (&rse, se);
3384	gfc_conv_expr_val (&rse, expr->value.op.op2);
3385	gfc_add_block_to_block (&se->pre, &rse.pre);
3386
3387	if (expr->value.op.op2->ts.type == BT_INTEGER
3388	&& expr->value.op.op2->expr_type == EXPR_CONSTANT)
3389	if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
3390	return;
3391
3392	if (INTEGER_CST_P (lse.expr)(((enum tree_code) (lse.expr)->base.code) == INTEGER_CST)
3393	&& TREE_CODE (TREE_TYPE (rse.expr))((enum tree_code) (((contains_struct_check ((rse.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3393, __FUNCTION__))->typed.type))->base.code) == INTEGER_TYPE)
3394	{
3395	wi::tree_to_wide_ref wlhs = wi::to_wide (lse.expr);
3396	HOST_WIDE_INTlong v, w;
3397	int kind, ikind, bit_size;
3398
3399	v = wlhs.to_shwi ();
3400	w = abs (v);
3401
3402	kind = expr->value.op.op1->ts.kind;
3403	ikind = gfc_validate_kind (BT_INTEGER, kind, false);
3404	bit_size = gfc_integer_kinds[ikind].bit_size;
3405
3406	if (v == 1)
3407	{
3408	/* 1*something is always 1. /
3409	se->expr = build_int_cst (TREE_TYPE (lse.expr)((contains_struct_check ((lse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3409, __FUNCTION__))->typed.type), 1);
3410	return;
3411	}
3412	else if (v == -1)
3413	{
3414	/* (-1)*n is 1 - ((n & 1) << 1) /
3415	tree type;
3416	tree tmp;
3417
3418	type = TREE_TYPE (lse.expr)((contains_struct_check ((lse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3418, __FUNCTION__))->typed.type);
3419	tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type,
3420	rse.expr, build_int_cst (type, 1));
3421	tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type,
3422	tmp, build_int_cst (type, 1));
3423	tmp = fold_build2_loc (input_location, MINUS_EXPR, type,
3424	build_int_cst (type, 1), tmp);
3425	se->expr = tmp;
3426	return;
3427	}
3428	else if (w > 0 && ((w & (w-1)) == 0) && ((w >> (bit_size-1)) == 0))
3429	{
3430	/* Here v is +/- 2**e. The further simplification uses
3431	2n = 1<<n, 4n = 1<<(n+n), 8*n = 1 <<(3n), 16**n =
3432	1<<(4*n), etc., but we have to make sure to return zero
3433	if the number of bits is too large. */
3434	tree lshift;
3435	tree type;
3436	tree shift;
3437	tree ge;
3438	tree cond;
3439	tree num_bits;
3440	tree cond2;
3441	tree tmp1;
3442
3443	type = TREE_TYPE (lse.expr)((contains_struct_check ((lse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3443, __FUNCTION__))->typed.type);
3444
3445	if (w == 2)
3446	shift = rse.expr;
3447	else if (w == 4)
3448	shift = fold_build2_loc (input_location, PLUS_EXPR,
3449	TREE_TYPE (rse.expr)((contains_struct_check ((rse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3449, __FUNCTION__))->typed.type),
3450	rse.expr, rse.expr);
3451	else
3452	{
3453	/* use popcount for fast log2(w) */
3454	int e = wi::popcount (w-1);
3455	shift = fold_build2_loc (input_location, MULT_EXPR,
3456	TREE_TYPE (rse.expr)((contains_struct_check ((rse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3456, __FUNCTION__))->typed.type),
3457	build_int_cst (TREE_TYPE (rse.expr)((contains_struct_check ((rse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3457, __FUNCTION__))->typed.type), e),
3458	rse.expr);
3459	}
3460
3461	lshift = fold_build2_loc (input_location, LSHIFT_EXPR, type,
3462	build_int_cst (type, 1), shift);
3463	ge = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
3464	rse.expr, build_int_cst (type, 0));
3465	cond = fold_build3_loc (input_location, COND_EXPR, type, ge, lshift,
3466	build_int_cst (type, 0));
3467	num_bits = build_int_cst (TREE_TYPE (rse.expr)((contains_struct_check ((rse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3467, __FUNCTION__))->typed.type), TYPE_PRECISION (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3467, __FUNCTION__))->type_common.precision));
3468	cond2 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
3469	rse.expr, num_bits);
3470	tmp1 = fold_build3_loc (input_location, COND_EXPR, type, cond2,
3471	build_int_cst (type, 0), cond);
3472	if (v > 0)
3473	{
3474	se->expr = tmp1;
3475	}
3476	else
3477	{
3478	/* for v < 0, calculate vn = \|v\|n * (-1)*n /
3479	tree tmp2;
3480	tmp2 = fold_build2_loc (input_location, BIT_AND_EXPR, type,
3481	rse.expr, build_int_cst (type, 1));
3482	tmp2 = fold_build2_loc (input_location, LSHIFT_EXPR, type,
3483	tmp2, build_int_cst (type, 1));
3484	tmp2 = fold_build2_loc (input_location, MINUS_EXPR, type,
3485	build_int_cst (type, 1), tmp2);
3486	se->expr = fold_build2_loc (input_location, MULT_EXPR, type,
3487	tmp1, tmp2);
3488	}
3489	return;
3490	}
3491	}
3492
3493	gfc_int4_type_node = gfc_get_int_type (4);
3494
3495	/* In case of integer operands with kinds 1 or 2, we call the integer kind 4
3496	library routine. But in the end, we have to convert the result back
3497	if this case applies -- with res_ikind_K, we keep track whether operand K
3498	falls into this case. */
3499	res_ikind_1 = -1;
3500	res_ikind_2 = -1;
3501
3502	kind = expr->value.op.op1->ts.kind;
3503	switch (expr->value.op.op2->ts.type)
3504	{
3505	case BT_INTEGER:
3506	ikind = expr->value.op.op2->ts.kind;
3507	switch (ikind)
3508	{
3509	case 1:
3510	case 2:
3511	rse.expr = convert (gfc_int4_type_node, rse.expr);
3512	res_ikind_2 = ikind;
3513	/* Fall through. */
3514
3515	case 4:
3516	ikind = 0;
3517	break;
3518
3519	case 8:
3520	ikind = 1;
3521	break;
3522
3523	case 16:
3524	ikind = 2;
3525	break;
3526
3527	default:
3528	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3528, __FUNCTION__));
3529	}
3530	switch (kind)
3531	{
3532	case 1:
3533	case 2:
3534	if (expr->value.op.op1->ts.type == BT_INTEGER)
3535	{
3536	lse.expr = convert (gfc_int4_type_node, lse.expr);
3537	res_ikind_1 = kind;
3538	}
3539	else
3540	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3540, __FUNCTION__));
3541	/* Fall through. */
3542
3543	case 4:
3544	kind = 0;
3545	break;
3546
3547	case 8:
3548	kind = 1;
3549	break;
3550
3551	case 10:
3552	kind = 2;
3553	break;
3554
3555	case 16:
3556	kind = 3;
3557	break;
3558
3559	default:
3560	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3560, __FUNCTION__));
3561	}
3562
3563	switch (expr->value.op.op1->ts.type)
3564	{
3565	case BT_INTEGER:
3566	if (kind == 3) /* Case 16 was not handled properly above. */
3567	kind = 2;
3568	fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
3569	break;
3570
3571	case BT_REAL:
3572	/* Use builtins for real ** int4. */
3573	if (ikind == 0)
3574	{
3575	switch (kind)
3576	{
3577	case 0:
3578	fndecl = builtin_decl_explicit (BUILT_IN_POWIF);
3579	break;
3580
3581	case 1:
3582	fndecl = builtin_decl_explicit (BUILT_IN_POWI);
3583	break;
3584
3585	case 2:
3586	fndecl = builtin_decl_explicit (BUILT_IN_POWIL);
3587	break;
3588
3589	case 3:
3590	/* Use the __builtin_powil() only if real(kind=16) is
3591	actually the C long double type. */
3592	if (!gfc_real16_is_float128)
3593	fndecl = builtin_decl_explicit (BUILT_IN_POWIL);
3594	break;
3595
3596	default:
3597	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3597, __FUNCTION__));
3598	}
3599	}
3600
3601	/* If we don't have a good builtin for this, go for the
3602	library function. */
3603	if (!fndecl)
3604	fndecl = gfor_fndecl_math_powi[kind][ikind].real;
3605	break;
3606
3607	case BT_COMPLEX:
3608	fndecl = gfor_fndecl_math_powi[kind][ikind].cmplx;
3609	break;
3610
3611	default:
3612	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3612, __FUNCTION__));
3613	}
3614	break;
3615
3616	case BT_REAL:
3617	fndecl = gfc_builtin_decl_for_float_kind (BUILT_IN_POW, kind);
3618	break;
3619
3620	case BT_COMPLEX:
3621	fndecl = gfc_builtin_decl_for_float_kind (BUILT_IN_CPOW, kind);
3622	break;
3623
3624	default:
3625	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3625, __FUNCTION__));
3626	break;
3627	}
3628
3629	se->expr = build_call_expr_loc (input_location,
3630	fndecl, 2, lse.expr, rse.expr);
3631
3632	/* Convert the result back if it is of wrong integer kind. */
3633	if (res_ikind_1 != -1 && res_ikind_2 != -1)
3634	{
3635	/* We want the maximum of both operand kinds as result. */
3636	if (res_ikind_1 < res_ikind_2)
3637	res_ikind_1 = res_ikind_2;
3638	se->expr = convert (gfc_get_int_type (res_ikind_1), se->expr);
3639	}
3640	}
3641
3642
3643	/* Generate code to allocate a string temporary. */
3644
3645	tree
3646	gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
3647	{
3648	tree var;
3649	tree tmp;
3650
3651	if (gfc_can_put_var_on_stack (len))
3652	{
3653	/* Create a temporary variable to hold the result. */
3654	tmp = fold_build2_loc (input_location, MINUS_EXPR,
3655	TREE_TYPE (len)((contains_struct_check ((len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3655, __FUNCTION__))->typed.type), len,
3656	build_int_cst (TREE_TYPE (len)((contains_struct_check ((len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3656, __FUNCTION__))->typed.type), 1));
3657	tmp = build_range_type (gfc_charlen_type_node, size_zero_nodeglobal_trees[TI_SIZE_ZERO], tmp);
3658
3659	if (TREE_CODE (TREE_TYPE (type))((enum tree_code) (((contains_struct_check ((type), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3659, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE)
3660	tmp = build_array_type (TREE_TYPE (TREE_TYPE (type))((contains_struct_check ((((contains_struct_check ((type), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3660, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3660, __FUNCTION__))->typed.type), tmp);
3661	else
3662	tmp = build_array_type (TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3662, __FUNCTION__))->typed.type), tmp);
3663
3664	var = gfc_create_var (tmp, "str");
3665	var = gfc_build_addr_expr (type, var);
3666	}
3667	else
3668	{
3669	/* Allocate a temporary to hold the result. */
3670	var = gfc_create_var (type, "pstr");
3671	gcc_assert (POINTER_TYPE_P (type))((void)(!((((enum tree_code) (type)->base.code) == POINTER_TYPE \|\| ((enum tree_code) (type)->base.code) == REFERENCE_TYPE )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3671, __FUNCTION__), 0 : 0));
3672	tmp = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3672, __FUNCTION__))->typed.type);
3673	if (TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == ARRAY_TYPE)
3674	tmp = TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3674, __FUNCTION__))->typed.type);
3675	tmp = TYPE_SIZE_UNIT (tmp)((tree_class_check ((tmp), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3675, __FUNCTION__))->type_common.size_unit);
3676	tmp = fold_build2_loc (input_location, MULT_EXPR, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3677	fold_convert (size_type_node, len)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], len),
3678	fold_convert (size_type_node, tmp)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], tmp));
3679	tmp = gfc_call_malloc (&se->pre, type, tmp);
3680	gfc_add_modify (&se->pre, var, tmp);
3681
3682	/* Free the temporary afterwards. */
3683	tmp = gfc_call_free (var);
3684	gfc_add_expr_to_block (&se->post, tmp);
3685	}
3686
3687	return var;
3688	}
3689
3690
3691	/* Handle a string concatenation operation. A temporary will be allocated to
3692	hold the result. */
3693
3694	static void
3695	gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
3696	{
3697	gfc_se lse, rse;
3698	tree len, type, var, tmp, fndecl;
3699
3700	gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER((void)(!(expr->value.op.op1->ts.type == BT_CHARACTER && expr->value.op.op2->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3701, __FUNCTION__), 0 : 0))
3701	&& expr->value.op.op2->ts.type == BT_CHARACTER)((void)(!(expr->value.op.op1->ts.type == BT_CHARACTER && expr->value.op.op2->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3701, __FUNCTION__), 0 : 0));
3702	gcc_assert (expr->value.op.op1->ts.kind == expr->value.op.op2->ts.kind)((void)(!(expr->value.op.op1->ts.kind == expr->value .op.op2->ts.kind) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3702, __FUNCTION__), 0 : 0));
3703
3704	gfc_init_se (&lse, se);
3705	gfc_conv_expr (&lse, expr->value.op.op1);
3706	gfc_conv_string_parameter (&lse);
3707	gfc_init_se (&rse, se);
3708	gfc_conv_expr (&rse, expr->value.op.op2);
3709	gfc_conv_string_parameter (&rse);
3710
3711	gfc_add_block_to_block (&se->pre, &lse.pre);
3712	gfc_add_block_to_block (&se->pre, &rse.pre);
3713
3714	type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl);
3715	len = TYPE_MAX_VALUE (TYPE_DOMAIN (type))((tree_check5 ((((tree_check ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3715, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values )), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3715, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval );
3716	if (len == NULL_TREE(tree) __null)
3717	{
3718	len = fold_build2_loc (input_location, PLUS_EXPR,
3719	gfc_charlen_type_node,
3720	fold_convert (gfc_charlen_type_node,fold_convert_loc (((location_t) 0), gfc_charlen_type_node, lse .string_length)
3721	lse.string_length)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, lse .string_length),
3722	fold_convert (gfc_charlen_type_node,fold_convert_loc (((location_t) 0), gfc_charlen_type_node, rse .string_length)
3723	rse.string_length)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, rse .string_length));
3724	}
3725
3726	type = build_pointer_type (type);
3727
3728	var = gfc_conv_string_tmp (se, type, len);
3729
3730	/* Do the actual concatenation. */
3731	if (expr->ts.kind == 1)
3732	fndecl = gfor_fndecl_concat_string;
3733	else if (expr->ts.kind == 4)
3734	fndecl = gfor_fndecl_concat_string_char4;
3735	else
3736	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3736, __FUNCTION__));
3737
3738	tmp = build_call_expr_loc (input_location,
3739	fndecl, 6, len, var, lse.string_length, lse.expr,
3740	rse.string_length, rse.expr);
3741	gfc_add_expr_to_block (&se->pre, tmp);
3742
3743	/* Add the cleanup for the operands. */
3744	gfc_add_block_to_block (&se->pre, &rse.post);
3745	gfc_add_block_to_block (&se->pre, &lse.post);
3746
3747	se->expr = var;
3748	se->string_length = len;
3749	}
3750
3751	/* Translates an op expression. Common (binary) cases are handled by this
3752	function, others are passed on. Recursion is used in either case.
3753	We use the fact that (op1.ts == op2.ts) (except for the power
3754	operator **).
3755	Operators need no special handling for scalarized expressions as long as
3756	they call gfc_conv_simple_val to get their operands.
3757	Character strings get special handling. */
3758
3759	static void
3760	gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
3761	{
3762	enum tree_code code;
3763	gfc_se lse;
3764	gfc_se rse;
3765	tree tmp, type;
3766	int lop;
3767	int checkstring;
3768
3769	checkstring = 0;
3770	lop = 0;
3771	switch (expr->value.op.op)
3772	{
3773	case INTRINSIC_PARENTHESES:
3774	if ((expr->ts.type == BT_REAL \|\| expr->ts.type == BT_COMPLEX)
3775	&& flag_protect_parensglobal_options.x_flag_protect_parens)
3776	{
3777	gfc_conv_unary_op (PAREN_EXPR, se, expr);
3778	gcc_assert (FLOAT_TYPE_P (TREE_TYPE (se->expr)))((void)(!(((((enum tree_code) (((contains_struct_check ((se-> expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3778, __FUNCTION__))->typed.type))->base.code) == REAL_TYPE ) \|\| ((((enum tree_code) (((contains_struct_check ((se->expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3778, __FUNCTION__))->typed.type))->base.code) == COMPLEX_TYPE \|\| (((enum tree_code) (((contains_struct_check ((se->expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3778, __FUNCTION__))->typed.type))->base.code) == VECTOR_TYPE )) && (((enum tree_code) (((contains_struct_check ((( (contains_struct_check ((se->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3778, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3778, __FUNCTION__))->typed.type))->base.code) == REAL_TYPE )))) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3778, __FUNCTION__), 0 : 0));
3779	return;
3780	}
3781
3782	/* Fallthrough. */
3783	case INTRINSIC_UPLUS:
3784	gfc_conv_expr (se, expr->value.op.op1);
3785	return;
3786
3787	case INTRINSIC_UMINUS:
3788	gfc_conv_unary_op (NEGATE_EXPR, se, expr);
3789	return;
3790
3791	case INTRINSIC_NOT:
3792	gfc_conv_unary_op (TRUTH_NOT_EXPR, se, expr);
3793	return;
3794
3795	case INTRINSIC_PLUS:
3796	code = PLUS_EXPR;
3797	break;
3798
3799	case INTRINSIC_MINUS:
3800	code = MINUS_EXPR;
3801	break;
3802
3803	case INTRINSIC_TIMES:
3804	code = MULT_EXPR;
3805	break;
3806
3807	case INTRINSIC_DIVIDE:
3808	/* If expr is a real or complex expr, use an RDIV_EXPR. If op1 is
3809	an integer, we must round towards zero, so we use a
3810	TRUNC_DIV_EXPR. */
3811	if (expr->ts.type == BT_INTEGER)
3812	code = TRUNC_DIV_EXPR;
3813	else
3814	code = RDIV_EXPR;
3815	break;
3816
3817	case INTRINSIC_POWER:
3818	gfc_conv_power_op (se, expr);
3819	return;
3820
3821	case INTRINSIC_CONCAT:
3822	gfc_conv_concat_op (se, expr);
3823	return;
3824
3825	case INTRINSIC_AND:
3826	code = flag_frontend_optimizeglobal_options.x_flag_frontend_optimize ? TRUTH_ANDIF_EXPR : TRUTH_AND_EXPR;
3827	lop = 1;
3828	break;
3829
3830	case INTRINSIC_OR:
3831	code = flag_frontend_optimizeglobal_options.x_flag_frontend_optimize ? TRUTH_ORIF_EXPR : TRUTH_OR_EXPR;
3832	lop = 1;
3833	break;
3834
3835	/* EQV and NEQV only work on logicals, but since we represent them
3836	as integers, we can use EQ_EXPR and NE_EXPR for them in GIMPLE. */
3837	case INTRINSIC_EQ:
3838	case INTRINSIC_EQ_OS:
3839	case INTRINSIC_EQV:
3840	code = EQ_EXPR;
3841	checkstring = 1;
3842	lop = 1;
3843	break;
3844
3845	case INTRINSIC_NE:
3846	case INTRINSIC_NE_OS:
3847	case INTRINSIC_NEQV:
3848	code = NE_EXPR;
3849	checkstring = 1;
3850	lop = 1;
3851	break;
3852
3853	case INTRINSIC_GT:
3854	case INTRINSIC_GT_OS:
3855	code = GT_EXPR;
3856	checkstring = 1;
3857	lop = 1;
3858	break;
3859
3860	case INTRINSIC_GE:
3861	case INTRINSIC_GE_OS:
3862	code = GE_EXPR;
3863	checkstring = 1;
3864	lop = 1;
3865	break;
3866
3867	case INTRINSIC_LT:
3868	case INTRINSIC_LT_OS:
3869	code = LT_EXPR;
3870	checkstring = 1;
3871	lop = 1;
3872	break;
3873
3874	case INTRINSIC_LE:
3875	case INTRINSIC_LE_OS:
3876	code = LE_EXPR;
3877	checkstring = 1;
3878	lop = 1;
3879	break;
3880
3881	case INTRINSIC_USER:
3882	case INTRINSIC_ASSIGN:
3883	/* These should be converted into function calls by the frontend. */
3884	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3884, __FUNCTION__));
3885
3886	default:
3887	fatal_error (input_location, "Unknown intrinsic op");
3888	return;
3889	}
3890
3891	/* The only exception to this is *, which is handled separately anyway. /
3892	gcc_assert (expr->value.op.op1->ts.type == expr->value.op.op2->ts.type)((void)(!(expr->value.op.op1->ts.type == expr->value .op.op2->ts.type) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3892, __FUNCTION__), 0 : 0));
3893
3894	if (checkstring && expr->value.op.op1->ts.type != BT_CHARACTER)
3895	checkstring = 0;
3896
3897	/* lhs */
3898	gfc_init_se (&lse, se);
3899	gfc_conv_expr (&lse, expr->value.op.op1);
3900	gfc_add_block_to_block (&se->pre, &lse.pre);
3901
3902	/* rhs */
3903	gfc_init_se (&rse, se);
3904	gfc_conv_expr (&rse, expr->value.op.op2);
3905	gfc_add_block_to_block (&se->pre, &rse.pre);
3906
3907	if (checkstring)
3908	{
3909	gfc_conv_string_parameter (&lse);
3910	gfc_conv_string_parameter (&rse);
3911
3912	lse.expr = gfc_build_compare_string (lse.string_length, lse.expr,
3913	rse.string_length, rse.expr,
3914	expr->value.op.op1->ts.kind,
3915	code);
3916	rse.expr = build_int_cst (TREE_TYPE (lse.expr)((contains_struct_check ((lse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3916, __FUNCTION__))->typed.type), 0);
3917	gfc_add_block_to_block (&lse.post, &rse.post);
3918	}
3919
3920	type = gfc_typenode_for_spec (&expr->ts);
3921
3922	if (lop)
3923	{
3924	/* The result of logical ops is always logical_type_node. */
3925	tmp = fold_build2_loc (input_location, code, logical_type_node,
3926	lse.expr, rse.expr);
3927	se->expr = convert (type, tmp);
3928	}
3929	else
3930	se->expr = fold_build2_loc (input_location, code, type, lse.expr, rse.expr);
3931
3932	/* Add the post blocks. */
3933	gfc_add_block_to_block (&se->post, &rse.post);
3934	gfc_add_block_to_block (&se->post, &lse.post);
3935	}
3936
3937	/* If a string's length is one, we convert it to a single character. */
3938
3939	tree
3940	gfc_string_to_single_character (tree len, tree str, int kind)
3941	{
3942
3943	if (len == NULL__null
3944	\|\| !tree_fits_uhwi_p (len)
3945	\|\| !POINTER_TYPE_P (TREE_TYPE (str))(((enum tree_code) (((contains_struct_check ((str), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3945, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((str), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3945, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
3946	return NULL_TREE(tree) __null;
3947
3948	if (TREE_INT_CST_LOW (len)((unsigned long) (*tree_int_cst_elt_check ((len), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3948, __FUNCTION__))) == 1)
3949	{
3950	str = fold_convert (gfc_get_pchar_type (kind), str)fold_convert_loc (((location_t) 0), gfc_get_pchar_type (kind) , str);
3951	return build_fold_indirect_ref_loc (input_location, str);
3952	}
3953
3954	if (kind == 1
3955	&& TREE_CODE (str)((enum tree_code) (str)->base.code) == ADDR_EXPR
3956	&& TREE_CODE (TREE_OPERAND (str, 0))((enum tree_code) ((((const_cast<tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3956, __FUNCTION__))))))->base.code) == ARRAY_REF
3957	&& TREE_CODE (TREE_OPERAND (TREE_OPERAND (str, 0), 0))((enum tree_code) ((((const_cast<tree> (tree_operand_check (((((const_cast<tree> (tree_operand_check ((str), (0 ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3957, __FUNCTION__)))))), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3957, __FUNCTION__))))))->base.code) == STRING_CST
3958	&& array_ref_low_bound (TREE_OPERAND (str, 0)(((const_cast<tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3958, __FUNCTION__))))))
3959	== TREE_OPERAND (TREE_OPERAND (str, 0), 1)(((const_cast<tree> (tree_operand_check (((((const_cast <tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3959, __FUNCTION__)))))), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3959, __FUNCTION__)))))
3960	&& TREE_INT_CST_LOW (len)((unsigned long) (*tree_int_cst_elt_check ((len), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3960, __FUNCTION__))) > 1
3961	&& TREE_INT_CST_LOW (len)((unsigned long) (*tree_int_cst_elt_check ((len), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3961, __FUNCTION__)))
3962	== (unsigned HOST_WIDE_INTlong)
3963	TREE_STRING_LENGTH (TREE_OPERAND (TREE_OPERAND (str, 0), 0))((tree_check (((((const_cast<tree> (tree_operand_check (((((const_cast<tree> (tree_operand_check ((str), (0 ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3963, __FUNCTION__)))))), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3963, __FUNCTION__)))))), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3963, __FUNCTION__, (STRING_CST)))->string.length))
3964	{
3965	tree ret = fold_convert (gfc_get_pchar_type (kind), str)fold_convert_loc (((location_t) 0), gfc_get_pchar_type (kind) , str);
3966	ret = build_fold_indirect_ref_loc (input_location, ret);
3967	if (TREE_CODE (ret)((enum tree_code) (ret)->base.code) == INTEGER_CST)
3968	{
3969	tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0)(((const_cast<tree> (tree_operand_check (((((const_cast <tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3969, __FUNCTION__)))))), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3969, __FUNCTION__)))));
3970	int i, length = TREE_STRING_LENGTH (string_cst)((tree_check ((string_cst), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3970, __FUNCTION__, (STRING_CST)))->string.length);
3971	const char ptr = TREE_STRING_POINTER (string_cst)((const char )((tree_check ((string_cst), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3971, __FUNCTION__, (STRING_CST)))->string.str));
3972
3973	for (i = 1; i < length; i++)
3974	if (ptr[i] != ' ')
3975	return NULL_TREE(tree) __null;
3976
3977	return ret;
3978	}
3979	}
3980
3981	return NULL_TREE(tree) __null;
3982	}
3983
3984
3985	static void
3986	conv_scalar_char_value (gfc_symbol sym, gfc_se se, gfc_expr **expr)
3987	{
3988	gcc_assert (expr)((void)(!(expr) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3988, __FUNCTION__), 0 : 0));
3989
3990	/* We used to modify the tree here. Now it is done earlier in
3991	the front-end, so we only check it here to avoid regressions. */
3992	if (sym->backend_decl)
3993	{
3994	gcc_assert (TREE_CODE (TREE_TYPE (sym->backend_decl)) == INTEGER_TYPE)((void)(!(((enum tree_code) (((contains_struct_check ((sym-> backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3994, __FUNCTION__))->typed.type))->base.code) == INTEGER_TYPE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3994, __FUNCTION__), 0 : 0));
3995	gcc_assert (TYPE_UNSIGNED (TREE_TYPE (sym->backend_decl)) == 1)((void)(!(((tree_class_check ((((contains_struct_check ((sym-> backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3995, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3995, __FUNCTION__))->base.u.bits.unsigned_flag) == 1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3995, __FUNCTION__), 0 : 0));
3996	gcc_assert (TYPE_PRECISION (TREE_TYPE (sym->backend_decl)) == CHAR_TYPE_SIZE)((void)(!(((tree_class_check ((((contains_struct_check ((sym-> backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3996, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3996, __FUNCTION__))->type_common.precision) == (8)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3996, __FUNCTION__), 0 : 0));
3997	gcc_assert (DECL_BY_REFERENCE (sym->backend_decl) == 0)((void)(!(((tree_check3 ((sym->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3997, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL)) )->decl_common.decl_by_reference_flag) == 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 3997, __FUNCTION__), 0 : 0));
3998	}
3999
4000	/* If we have a constant character expression, make it into an
4001	integer of type C char. */
4002	if ((*expr)->expr_type == EXPR_CONSTANT)
4003	{
4004	gfc_typespec ts;
4005	gfc_clear_ts (&ts);
4006
4007	*expr = gfc_get_int_expr (gfc_default_character_kind, NULL__null,
4008	(*expr)->value.character.string[0]);
4009	}
4010	else if (se != NULL__null && (*expr)->expr_type == EXPR_VARIABLE)
4011	{
4012	if ((*expr)->ref == NULL__null)
4013	{
4014	se->expr = gfc_string_to_single_character
4015	(build_int_cst (integer_type_nodeinteger_types[itk_int], 1),
4016	gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
4017	gfc_get_symbol_decl
4018	((*expr)->symtree->n.sym)),
4019	(*expr)->ts.kind);
4020	}
4021	else
4022	{
4023	gfc_conv_variable (se, *expr);
4024	se->expr = gfc_string_to_single_character
4025	(build_int_cst (integer_type_nodeinteger_types[itk_int], 1),
4026	gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
4027	se->expr),
4028	(*expr)->ts.kind);
4029	}
4030	}
4031	}
4032
4033	/* Helper function for gfc_build_compare_string. Return LEN_TRIM value
4034	if STR is a string literal, otherwise return -1. */
4035
4036	static int
4037	gfc_optimize_len_trim (tree len, tree str, int kind)
4038	{
4039	if (kind == 1
4040	&& TREE_CODE (str)((enum tree_code) (str)->base.code) == ADDR_EXPR
4041	&& TREE_CODE (TREE_OPERAND (str, 0))((enum tree_code) ((((const_cast<tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4041, __FUNCTION__))))))->base.code) == ARRAY_REF
4042	&& TREE_CODE (TREE_OPERAND (TREE_OPERAND (str, 0), 0))((enum tree_code) ((((const_cast<tree> (tree_operand_check (((((const_cast<tree> (tree_operand_check ((str), (0 ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4042, __FUNCTION__)))))), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4042, __FUNCTION__))))))->base.code) == STRING_CST
4043	&& array_ref_low_bound (TREE_OPERAND (str, 0)(((const_cast<tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4043, __FUNCTION__))))))
4044	== TREE_OPERAND (TREE_OPERAND (str, 0), 1)(((const_cast<tree> (tree_operand_check (((((const_cast <tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4044, __FUNCTION__)))))), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4044, __FUNCTION__)))))
4045	&& tree_fits_uhwi_p (len)
4046	&& tree_to_uhwi (len) >= 1
4047	&& tree_to_uhwi (len)
4048	== (unsigned HOST_WIDE_INTlong)
4049	TREE_STRING_LENGTH (TREE_OPERAND (TREE_OPERAND (str, 0), 0))((tree_check (((((const_cast<tree> (tree_operand_check (((((const_cast<tree> (tree_operand_check ((str), (0 ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4049, __FUNCTION__)))))), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4049, __FUNCTION__)))))), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4049, __FUNCTION__, (STRING_CST)))->string.length))
4050	{
4051	tree folded = fold_convert (gfc_get_pchar_type (kind), str)fold_convert_loc (((location_t) 0), gfc_get_pchar_type (kind) , str);
4052	folded = build_fold_indirect_ref_loc (input_location, folded);
4053	if (TREE_CODE (folded)((enum tree_code) (folded)->base.code) == INTEGER_CST)
4054	{
4055	tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0)(((const_cast<tree> (tree_operand_check (((((const_cast <tree> (tree_operand_check ((str), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4055, __FUNCTION__)))))), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4055, __FUNCTION__)))));
4056	int length = TREE_STRING_LENGTH (string_cst)((tree_check ((string_cst), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4056, __FUNCTION__, (STRING_CST)))->string.length);
4057	const char ptr = TREE_STRING_POINTER (string_cst)((const char )((tree_check ((string_cst), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4057, __FUNCTION__, (STRING_CST)))->string.str));
4058
4059	for (; length > 0; length--)
4060	if (ptr[length - 1] != ' ')
4061	break;
4062
4063	return length;
4064	}
4065	}
4066	return -1;
4067	}
4068
4069	/* Helper to build a call to memcmp. */
4070
4071	static tree
4072	build_memcmp_call (tree s1, tree s2, tree n)
4073	{
4074	tree tmp;
4075
4076	if (!POINTER_TYPE_P (TREE_TYPE (s1))(((enum tree_code) (((contains_struct_check ((s1), (TS_TYPED) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4076, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((s1), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4076, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
4077	s1 = gfc_build_addr_expr (pvoid_type_node, s1);
4078	else
4079	s1 = fold_convert (pvoid_type_node, s1)fold_convert_loc (((location_t) 0), pvoid_type_node, s1);
4080
4081	if (!POINTER_TYPE_P (TREE_TYPE (s2))(((enum tree_code) (((contains_struct_check ((s2), (TS_TYPED) , "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4081, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((s2), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4081, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
4082	s2 = gfc_build_addr_expr (pvoid_type_node, s2);
4083	else
4084	s2 = fold_convert (pvoid_type_node, s2)fold_convert_loc (((location_t) 0), pvoid_type_node, s2);
4085
4086	n = fold_convert (size_type_node, n)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], n);
4087
4088	tmp = build_call_expr_loc (input_location,
4089	builtin_decl_explicit (BUILT_IN_MEMCMP),
4090	3, s1, s2, n);
4091
4092	return fold_convert (integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_int], tmp );
4093	}
4094
4095	/* Compare two strings. If they are all single characters, the result is the
4096	subtraction of them. Otherwise, we build a library call. */
4097
4098	tree
4099	gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind,
4100	enum tree_code code)
4101	{
4102	tree sc1;
4103	tree sc2;
4104	tree fndecl;
4105
4106	gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1)))((void)(!((((enum tree_code) (((contains_struct_check ((str1) , (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4106, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((str1), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4106, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4106, __FUNCTION__), 0 : 0));
4107	gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2)))((void)(!((((enum tree_code) (((contains_struct_check ((str2) , (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4107, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((str2), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4107, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4107, __FUNCTION__), 0 : 0));
4108
4109	sc1 = gfc_string_to_single_character (len1, str1, kind);
4110	sc2 = gfc_string_to_single_character (len2, str2, kind);
4111
4112	if (sc1 != NULL_TREE(tree) __null && sc2 != NULL_TREE(tree) __null)
4113	{
4114	/* Deal with single character specially. */
4115	sc1 = fold_convert (integer_type_node, sc1)fold_convert_loc (((location_t) 0), integer_types[itk_int], sc1 );
4116	sc2 = fold_convert (integer_type_node, sc2)fold_convert_loc (((location_t) 0), integer_types[itk_int], sc2 );
4117	return fold_build2_loc (input_location, MINUS_EXPR, integer_type_nodeinteger_types[itk_int],
4118	sc1, sc2);
4119	}
4120
4121	if ((code == EQ_EXPR \|\| code == NE_EXPR)
4122	&& optimizeglobal_options.x_optimize
4123	&& INTEGER_CST_P (len1)(((enum tree_code) (len1)->base.code) == INTEGER_CST) && INTEGER_CST_P (len2)(((enum tree_code) (len2)->base.code) == INTEGER_CST))
4124	{
4125	/* If one string is a string literal with LEN_TRIM longer
4126	than the length of the second string, the strings
4127	compare unequal. */
4128	int len = gfc_optimize_len_trim (len1, str1, kind);
4129	if (len > 0 && compare_tree_int (len2, len) < 0)
4130	return integer_one_nodeglobal_trees[TI_INTEGER_ONE];
4131	len = gfc_optimize_len_trim (len2, str2, kind);
4132	if (len > 0 && compare_tree_int (len1, len) < 0)
4133	return integer_one_nodeglobal_trees[TI_INTEGER_ONE];
4134	}
4135
4136	/* We can compare via memcpy if the strings are known to be equal
4137	in length and they are
4138	- kind=1
4139	- kind=4 and the comparison is for (in)equality. */
4140
4141	if (INTEGER_CST_P (len1)(((enum tree_code) (len1)->base.code) == INTEGER_CST) && INTEGER_CST_P (len2)(((enum tree_code) (len2)->base.code) == INTEGER_CST)
4142	&& tree_int_cst_equal (len1, len2)
4143	&& (kind == 1 \|\| code == EQ_EXPR \|\| code == NE_EXPR))
4144	{
4145	tree tmp;
4146	tree chartype;
4147
4148	chartype = gfc_get_char_type (kind);
4149	tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE(len1)((contains_struct_check ((len1), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4149, __FUNCTION__))->typed.type),
4150	fold_convert (TREE_TYPE(len1),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (len1), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4150, __FUNCTION__))->typed.type), ((tree_class_check (( chartype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4151, __FUNCTION__))->type_common.size_unit))
4151	TYPE_SIZE_UNIT(chartype))fold_convert_loc (((location_t) 0), ((contains_struct_check ( (len1), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4150, __FUNCTION__))->typed.type), ((tree_class_check (( chartype), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4151, __FUNCTION__))->type_common.size_unit)),
4152	len1);
4153	return build_memcmp_call (str1, str2, tmp);
4154	}
4155
4156	/* Build a call for the comparison. */
4157	if (kind == 1)
4158	fndecl = gfor_fndecl_compare_string;
4159	else if (kind == 4)
4160	fndecl = gfor_fndecl_compare_string_char4;
4161	else
4162	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4162, __FUNCTION__));
4163
4164	return build_call_expr_loc (input_location, fndecl, 4,
4165	len1, str1, len2, str2);
4166	}
4167
4168
4169	/* Return the backend_decl for a procedure pointer component. */
4170
4171	static tree
4172	get_proc_ptr_comp (gfc_expr *e)
4173	{
4174	gfc_se comp_se;
4175	gfc_expr *e2;
4176	expr_t old_type;
4177
4178	gfc_init_se (&comp_se, NULL__null);
4179	e2 = gfc_copy_expr (e);
4180	/* We have to restore the expr type later so that gfc_free_expr frees
4181	the exact same thing that was allocated.
4182	TODO: This is ugly. */
4183	old_type = e2->expr_type;
4184	e2->expr_type = EXPR_VARIABLE;
4185	gfc_conv_expr (&comp_se, e2);
4186	e2->expr_type = old_type;
4187	gfc_free_expr (e2);
4188	return build_fold_addr_expr_loc (input_location, comp_se.expr);
4189	}
4190
4191
4192	/* Convert a typebound function reference from a class object. */
4193	static void
4194	conv_base_obj_fcn_val (gfc_se * se, tree base_object, gfc_expr * expr)
4195	{
4196	gfc_ref *ref;
4197	tree var;
4198
4199	if (!VAR_P (base_object)(((enum tree_code) (base_object)->base.code) == VAR_DECL))
4200	{
4201	var = gfc_create_var (TREE_TYPE (base_object)((contains_struct_check ((base_object), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4201, __FUNCTION__))->typed.type), NULL__null);
4202	gfc_add_modify (&se->pre, var, base_object);
4203	}
4204	se->expr = gfc_class_vptr_get (base_object);
4205	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
4206	ref = expr->ref;
4207	while (ref && ref->next)
4208	ref = ref->next;
4209	gcc_assert (ref && ref->type == REF_COMPONENT)((void)(!(ref && ref->type == REF_COMPONENT) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4209, __FUNCTION__), 0 : 0));
4210	if (ref->u.c.sym->attr.extension)
4211	conv_parent_component_references (se, ref);
4212	gfc_conv_component_ref (se, ref);
4213	se->expr = build_fold_addr_expr_loc (input_location, se->expr);
4214	}
4215
4216
4217	static void
4218	conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr,
4219	gfc_actual_arglist *actual_args)
4220	{
4221	tree tmp;
4222
4223	if (gfc_is_proc_ptr_comp (expr))
4224	tmp = get_proc_ptr_comp (expr);
4225	else if (sym->attr.dummy)
4226	{
4227	tmp = gfc_get_symbol_decl (sym);
4228	if (sym->attr.proc_pointer)
4229	tmp = build_fold_indirect_ref_loc (input_location,
4230	tmp);
4231	gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE((void)(!(((enum tree_code) (((contains_struct_check ((tmp), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4231, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE && ((enum tree_code) (((contains_struct_check ((((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4232, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4232, __FUNCTION__))->typed.type))->base.code) == FUNCTION_TYPE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4232, __FUNCTION__), 0 : 0))
4232	&& TREE_CODE (TREE_TYPE (TREE_TYPE (tmp))) == FUNCTION_TYPE)((void)(!(((enum tree_code) (((contains_struct_check ((tmp), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4231, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE && ((enum tree_code) (((contains_struct_check ((((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4232, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4232, __FUNCTION__))->typed.type))->base.code) == FUNCTION_TYPE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4232, __FUNCTION__), 0 : 0));
4233	}
4234	else
4235	{
4236	if (!sym->backend_decl)
4237	sym->backend_decl = gfc_get_extern_function_decl (sym, actual_args);
4238
4239	TREE_USED (sym->backend_decl)((sym->backend_decl)->base.used_flag) = 1;
4240
4241	tmp = sym->backend_decl;
4242
4243	if (sym->attr.cray_pointee)
4244	{
4245	/* TODO - make the cray pointee a pointer to a procedure,
4246	assign the pointer to it and use it for the call. This
4247	will do for now! */
4248	tmp = convert (build_pointer_type (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4248, __FUNCTION__))->typed.type)),
4249	gfc_get_symbol_decl (sym->cp_pointer));
4250	tmp = gfc_evaluate_now (tmp, &se->pre);
4251	}
4252
4253	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-expr.cc" , 4253, __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-expr.cc" , 4253, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
4254	{
4255	gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL)((void)(!(((enum tree_code) (tmp)->base.code) == FUNCTION_DECL ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4255, __FUNCTION__), 0 : 0));
4256	tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
4257	}
4258	}
4259	se->expr = tmp;
4260	}
4261
4262
4263	/* Initialize MAPPING. */
4264
4265	void
4266	gfc_init_interface_mapping (gfc_interface_mapping * mapping)
4267	{
4268	mapping->syms = NULL__null;
4269	mapping->charlens = NULL__null;
4270	}
4271
4272
4273	/* Free all memory held by MAPPING (but not MAPPING itself). */
4274
4275	void
4276	gfc_free_interface_mapping (gfc_interface_mapping * mapping)
4277	{
4278	gfc_interface_sym_mapping *sym;
4279	gfc_interface_sym_mapping *nextsym;
4280	gfc_charlen *cl;
4281	gfc_charlen *nextcl;
4282
4283	for (sym = mapping->syms; sym; sym = nextsym)
4284	{
4285	nextsym = sym->next;
4286	sym->new_sym->n.sym->formal = NULL__null;
4287	gfc_free_symbol (sym->new_sym->n.sym);
4288	gfc_free_expr (sym->expr);
4289	free (sym->new_sym);
4290	free (sym);
4291	}
4292	for (cl = mapping->charlens; cl; cl = nextcl)
4293	{
4294	nextcl = cl->next;
4295	gfc_free_expr (cl->length);
4296	free (cl);
4297	}
4298	}
4299
4300
4301	/* Return a copy of gfc_charlen CL. Add the returned structure to
4302	MAPPING so that it will be freed by gfc_free_interface_mapping. */
4303
4304	static gfc_charlen *
4305	gfc_get_interface_mapping_charlen (gfc_interface_mapping * mapping,
4306	gfc_charlen * cl)
4307	{
4308	gfc_charlen *new_charlen;
4309
4310	new_charlen = gfc_get_charlen ()((gfc_charlen *) xcalloc (1, sizeof (gfc_charlen)));
4311	new_charlen->next = mapping->charlens;
4312	new_charlen->length = gfc_copy_expr (cl->length);
4313
4314	mapping->charlens = new_charlen;
4315	return new_charlen;
4316	}
4317
4318
4319	/* A subroutine of gfc_add_interface_mapping. Return a descriptorless
4320	array variable that can be used as the actual argument for dummy
4321	argument SYM. Add any initialization code to BLOCK. PACKED is as
4322	for gfc_get_nodesc_array_type and DATA points to the first element
4323	in the passed array. */
4324
4325	static tree
4326	gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym,
4327	gfc_packed packed, tree data)
4328	{
4329	tree type;
4330	tree var;
4331
4332	type = gfc_typenode_for_spec (&sym->ts);
4333	type = gfc_get_nodesc_array_type (type, sym->as, packed,
4334	!sym->attr.target && !sym->attr.pointer
4335	&& !sym->attr.proc_pointer);
4336
4337	var = gfc_create_var (type, "ifm");
4338	gfc_add_modify (block, var, fold_convert (type, data)fold_convert_loc (((location_t) 0), type, data));
4339
4340	return var;
4341	}
4342
4343
4344	/* A subroutine of gfc_add_interface_mapping. Set the stride, upper bounds
4345	and offset of descriptorless array type TYPE given that it has the same
4346	size as DESC. Add any set-up code to BLOCK. */
4347
4348	static void
4349	gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc)
4350	{
4351	int n;
4352	tree dim;
4353	tree offset;
4354	tree tmp;
4355
4356	offset = gfc_index_zero_nodegfc_rank_cst[0];
4357	for (n = 0; n < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4357, __FUNCTION__))->type_with_lang_specific.lang_specific )->rank); n++)
4358	{
4359	dim = gfc_rank_cst[n];
4360	GFC_TYPE_ARRAY_STRIDE (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4360, __FUNCTION__))->type_with_lang_specific.lang_specific )->stride[n]) = gfc_conv_array_stride (desc, n);
4361	if (GFC_TYPE_ARRAY_LBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4361, __FUNCTION__))->type_with_lang_specific.lang_specific )->lbound[n]) == NULL_TREE(tree) __null)
4362	{
4363	GFC_TYPE_ARRAY_LBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4363, __FUNCTION__))->type_with_lang_specific.lang_specific )->lbound[n])
4364	= gfc_conv_descriptor_lbound_get (desc, dim);
4365	GFC_TYPE_ARRAY_UBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4365, __FUNCTION__))->type_with_lang_specific.lang_specific )->ubound[n])
4366	= gfc_conv_descriptor_ubound_get (desc, dim);
4367	}
4368	else if (GFC_TYPE_ARRAY_UBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4368, __FUNCTION__))->type_with_lang_specific.lang_specific )->ubound[n]) == NULL_TREE(tree) __null)
4369	{
4370	tmp = fold_build2_loc (input_location, MINUS_EXPR,
4371	gfc_array_index_type,
4372	gfc_conv_descriptor_ubound_get (desc, dim),
4373	gfc_conv_descriptor_lbound_get (desc, dim));
4374	tmp = fold_build2_loc (input_location, PLUS_EXPR,
4375	gfc_array_index_type,
4376	GFC_TYPE_ARRAY_LBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4376, __FUNCTION__))->type_with_lang_specific.lang_specific )->lbound[n]), tmp);
4377	tmp = gfc_evaluate_now (tmp, block);
4378	GFC_TYPE_ARRAY_UBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4378, __FUNCTION__))->type_with_lang_specific.lang_specific )->ubound[n]) = tmp;
4379	}
4380	tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
4381	GFC_TYPE_ARRAY_LBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4381, __FUNCTION__))->type_with_lang_specific.lang_specific )->lbound[n]),
4382	GFC_TYPE_ARRAY_STRIDE (type, n)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4382, __FUNCTION__))->type_with_lang_specific.lang_specific )->stride[n]));
4383	offset = fold_build2_loc (input_location, MINUS_EXPR,
4384	gfc_array_index_type, offset, tmp);
4385	}
4386	offset = gfc_evaluate_now (offset, block);
4387	GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4387, __FUNCTION__))->type_with_lang_specific.lang_specific )->offset) = offset;
4388	}
4389
4390
4391	/* Extend MAPPING so that it maps dummy argument SYM to the value stored
4392	in SE. The caller may still use se->expr and se->string_length after
4393	calling this function. */
4394
4395	void
4396	gfc_add_interface_mapping (gfc_interface_mapping * mapping,
4397	gfc_symbol * sym, gfc_se * se,
4398	gfc_expr *expr)
4399	{
4400	gfc_interface_sym_mapping *sm;
4401	tree desc;
4402	tree tmp;
4403	tree value;
4404	gfc_symbol *new_sym;
4405	gfc_symtree *root;
4406	gfc_symtree *new_symtree;
4407
4408	/* Create a new symbol to represent the actual argument. */
4409	new_sym = gfc_new_symbol (sym->name, NULL__null);
4410	new_sym->ts = sym->ts;
4411	new_sym->as = gfc_copy_array_spec (sym->as);
4412	new_sym->attr.referenced = 1;
4413	new_sym->attr.dimension = sym->attr.dimension;
4414	new_sym->attr.contiguous = sym->attr.contiguous;
4415	new_sym->attr.codimension = sym->attr.codimension;
4416	new_sym->attr.pointer = sym->attr.pointer;
4417	new_sym->attr.allocatable = sym->attr.allocatable;
4418	new_sym->attr.flavor = sym->attr.flavor;
4419	new_sym->attr.function = sym->attr.function;
4420
4421	/* Ensure that the interface is available and that
4422	descriptors are passed for array actual arguments. */
4423	if (sym->attr.flavor == FL_PROCEDURE)
4424	{
4425	new_sym->formal = expr->symtree->n.sym->formal;
4426	new_sym->attr.always_explicit
4427	= expr->symtree->n.sym->attr.always_explicit;
4428	}
4429
4430	/* Create a fake symtree for it. */
4431	root = NULL__null;
4432	new_symtree = gfc_new_symtree (&root, sym->name);
4433	new_symtree->n.sym = new_sym;
4434	gcc_assert (new_symtree == root)((void)(!(new_symtree == root) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4434, __FUNCTION__), 0 : 0));
4435
4436	/* Create a dummy->actual mapping. */
4437	sm = XCNEW (gfc_interface_sym_mapping)((gfc_interface_sym_mapping *) xcalloc (1, sizeof (gfc_interface_sym_mapping )));
4438	sm->next = mapping->syms;
4439	sm->old = sym;
4440	sm->new_sym = new_symtree;
4441	sm->expr = gfc_copy_expr (expr);
4442	mapping->syms = sm;
4443
4444	/* Stabilize the argument's value. */
4445	if (!sym->attr.function && se)
4446	se->expr = gfc_evaluate_now (se->expr, &se->pre);
4447
4448	if (sym->ts.type == BT_CHARACTER)
4449	{
4450	/* Create a copy of the dummy argument's length. */
4451	new_sym->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.u.cl);
4452	sm->expr->ts.u.cl = new_sym->ts.u.cl;
4453
4454	/* If the length is specified as "*", record the length that
4455	the caller is passing. We should use the callee's length
4456	in all other cases. */
4457	if (!new_sym->ts.u.cl->length && se)
4458	{
4459	se->string_length = gfc_evaluate_now (se->string_length, &se->pre);
4460	new_sym->ts.u.cl->backend_decl = se->string_length;
4461	}
4462	}
4463
4464	if (!se)
4465	return;
4466
4467	/* Use the passed value as-is if the argument is a function. */
4468	if (sym->attr.flavor == FL_PROCEDURE)
4469	value = se->expr;
4470
4471	/* If the argument is a pass-by-value scalar, use the value as is. */
4472	else if (!sym->attr.dimension && sym->attr.value)
4473	value = se->expr;
4474
4475	/* If the argument is either a string or a pointer to a string,
4476	convert it to a boundless character type. */
4477	else if (!sym->attr.dimension && sym->ts.type == BT_CHARACTER)
4478	{
4479	tmp = gfc_get_character_type_len (sym->ts.kind, NULL__null);
4480	tmp = build_pointer_type (tmp);
4481	if (sym->attr.pointer)
4482	value = build_fold_indirect_ref_loc (input_location,
4483	se->expr);
4484	else
4485	value = se->expr;
4486	value = fold_convert (tmp, value)fold_convert_loc (((location_t) 0), tmp, value);
4487	}
4488
4489	/* If the argument is a scalar, a pointer to an array or an allocatable,
4490	dereference it. */
4491	else if (!sym->attr.dimension \|\| sym->attr.pointer \|\| sym->attr.allocatable)
4492	value = build_fold_indirect_ref_loc (input_location,
4493	se->expr);
4494
4495	/* For character(), use the actual argument's descriptor. /
4496	else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.u.cl->length)
4497	value = build_fold_indirect_ref_loc (input_location,
4498	se->expr);
4499
4500	/* If the argument is an array descriptor, use it to determine
4501	information about the actual argument's shape. */
4502	else if (POINTER_TYPE_P (TREE_TYPE (se->expr))(((enum tree_code) (((contains_struct_check ((se->expr), ( TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4502, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((se->expr) , (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4502, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE )
4503	&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se->expr)))((tree_class_check ((((contains_struct_check ((((contains_struct_check ((se->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4503, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4503, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4503, __FUNCTION__))->type_common.lang_flag_1))
4504	{
4505	/* Get the actual argument's descriptor. */
4506	desc = build_fold_indirect_ref_loc (input_location,
4507	se->expr);
4508
4509	/* Create the replacement variable. */
4510	tmp = gfc_conv_descriptor_data_get (desc);
4511	value = gfc_get_interface_mapping_array (&se->pre, sym,
4512	PACKED_NO, tmp);
4513
4514	/* Use DESC to work out the upper bounds, strides and offset. */
4515	gfc_set_interface_mapping_bounds (&se->pre, TREE_TYPE (value)((contains_struct_check ((value), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4515, __FUNCTION__))->typed.type), desc);
4516	}
4517	else
4518	/* Otherwise we have a packed array. */
4519	value = gfc_get_interface_mapping_array (&se->pre, sym,
4520	PACKED_FULL, se->expr);
4521
4522	new_sym->backend_decl = value;
4523	}
4524
4525
4526	/* Called once all dummy argument mappings have been added to MAPPING,
4527	but before the mapping is used to evaluate expressions. Pre-evaluate
4528	the length of each argument, adding any initialization code to PRE and
4529	any finalization code to POST. */
4530
4531	static void
4532	gfc_finish_interface_mapping (gfc_interface_mapping * mapping,
4533	stmtblock_t * pre, stmtblock_t * post)
4534	{
4535	gfc_interface_sym_mapping *sym;
4536	gfc_expr *expr;
4537	gfc_se se;
4538
4539	for (sym = mapping->syms; sym; sym = sym->next)
4540	if (sym->new_sym->n.sym->ts.type == BT_CHARACTER
4541	&& !sym->new_sym->n.sym->ts.u.cl->backend_decl)
4542	{
4543	expr = sym->new_sym->n.sym->ts.u.cl->length;
4544	gfc_apply_interface_mapping_to_expr (mapping, expr);
4545	gfc_init_se (&se, NULL__null);
4546	gfc_conv_expr (&se, expr);
4547	se.expr = fold_convert (gfc_charlen_type_node, se.expr)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, se .expr);
4548	se.expr = gfc_evaluate_now (se.expr, &se.pre);
4549	gfc_add_block_to_block (pre, &se.pre);
4550	gfc_add_block_to_block (post, &se.post);
4551
4552	sym->new_sym->n.sym->ts.u.cl->backend_decl = se.expr;
4553	}
4554	}
4555
4556
4557	/* Like gfc_apply_interface_mapping_to_expr, but applied to
4558	constructor C. */
4559
4560	static void
4561	gfc_apply_interface_mapping_to_cons (gfc_interface_mapping * mapping,
4562	gfc_constructor_base base)
4563	{
4564	gfc_constructor *c;
4565	for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
4566	{
4567	gfc_apply_interface_mapping_to_expr (mapping, c->expr);
4568	if (c->iterator)
4569	{
4570	gfc_apply_interface_mapping_to_expr (mapping, c->iterator->start);
4571	gfc_apply_interface_mapping_to_expr (mapping, c->iterator->end);
4572	gfc_apply_interface_mapping_to_expr (mapping, c->iterator->step);
4573	}
4574	}
4575	}
4576
4577
4578	/* Like gfc_apply_interface_mapping_to_expr, but applied to
4579	reference REF. */
4580
4581	static void
4582	gfc_apply_interface_mapping_to_ref (gfc_interface_mapping * mapping,
4583	gfc_ref * ref)
4584	{
4585	int n;
4586
4587	for (; ref; ref = ref->next)
4588	switch (ref->type)
4589	{
4590	case REF_ARRAY:
4591	for (n = 0; n < ref->u.ar.dimen; n++)
4592	{
4593	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.start[n]);
4594	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.end[n]);
4595	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.stride[n]);
4596	}
4597	break;
4598
4599	case REF_COMPONENT:
4600	case REF_INQUIRY:
4601	break;
4602
4603	case REF_SUBSTRING:
4604	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.start);
4605	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.end);
4606	break;
4607	}
4608	}
4609
4610
4611	/* Convert intrinsic function calls into result expressions. */
4612
4613	static bool
4614	gfc_map_intrinsic_function (gfc_expr expr, gfc_interface_mapping mapping)
4615	{
4616	gfc_symbol *sym;
4617	gfc_expr *new_expr;
4618	gfc_expr *arg1;
4619	gfc_expr *arg2;
4620	int d, dup;
4621
4622	arg1 = expr->value.function.actual->expr;
4623	if (expr->value.function.actual->next)
4624	arg2 = expr->value.function.actual->next->expr;
4625	else
4626	arg2 = NULL__null;
4627
4628	sym = arg1->symtree->n.sym;
4629
4630	if (sym->attr.dummy)
4631	return false;
4632
4633	new_expr = NULL__null;
4634
4635	switch (expr->value.function.isym->id)
4636	{
4637	case GFC_ISYM_LEN:
4638	/* TODO figure out why this condition is necessary. */
4639	if (sym->attr.function
4640	&& (arg1->ts.u.cl->length == NULL__null
4641	\|\| (arg1->ts.u.cl->length->expr_type != EXPR_CONSTANT
4642	&& arg1->ts.u.cl->length->expr_type != EXPR_VARIABLE)))
4643	return false;
4644
4645	new_expr = gfc_copy_expr (arg1->ts.u.cl->length);
4646	break;
4647
4648	case GFC_ISYM_LEN_TRIM:
4649	new_expr = gfc_copy_expr (arg1);
4650	gfc_apply_interface_mapping_to_expr (mapping, new_expr);
4651
4652	if (!new_expr)
4653	return false;
4654
4655	gfc_replace_expr (arg1, new_expr);
4656	return true;
4657
4658	case GFC_ISYM_SIZE:
4659	if (!sym->as \|\| sym->as->rank == 0)
4660	return false;
4661
4662	if (arg2 && arg2->expr_type == EXPR_CONSTANT)
4663	{
4664	dup = mpz_get_si__gmpz_get_si (arg2->value.integer);
4665	d = dup - 1;
4666	}
4667	else
4668	{
4669	dup = sym->as->rank;
4670	d = 0;
4671	}
4672
4673	for (; d < dup; d++)
4674	{
4675	gfc_expr *tmp;
4676
4677	if (!sym->as->upper[d] \|\| !sym->as->lower[d])
4678	{
4679	gfc_free_expr (new_expr);
4680	return false;
4681	}
4682
4683	tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]),
4684	gfc_get_int_expr (gfc_default_integer_kind,
4685	NULL__null, 1));
4686	tmp = gfc_subtract (tmp, gfc_copy_expr (sym->as->lower[d]));
4687	if (new_expr)
4688	new_expr = gfc_multiply (new_expr, tmp);
4689	else
4690	new_expr = tmp;
4691	}
4692	break;
4693
4694	case GFC_ISYM_LBOUND:
4695	case GFC_ISYM_UBOUND:
4696	/* TODO These implementations of lbound and ubound do not limit if
4697	the size < 0, according to F95's 13.14.53 and 13.14.113. */
4698
4699	if (!sym->as \|\| sym->as->rank == 0)
4700	return false;
4701
4702	if (arg2 && arg2->expr_type == EXPR_CONSTANT)
4703	d = mpz_get_si__gmpz_get_si (arg2->value.integer) - 1;
4704	else
4705	return false;
4706
4707	if (expr->value.function.isym->id == GFC_ISYM_LBOUND)
4708	{
4709	if (sym->as->lower[d])
4710	new_expr = gfc_copy_expr (sym->as->lower[d]);
4711	}
4712	else
4713	{
4714	if (sym->as->upper[d])
4715	new_expr = gfc_copy_expr (sym->as->upper[d]);
4716	}
4717	break;
4718
4719	default:
4720	break;
4721	}
4722
4723	gfc_apply_interface_mapping_to_expr (mapping, new_expr);
4724	if (!new_expr)
4725	return false;
4726
4727	gfc_replace_expr (expr, new_expr);
4728	return true;
4729	}
4730
4731
4732	static void
4733	gfc_map_fcn_formal_to_actual (gfc_expr expr, gfc_expr map_expr,
4734	gfc_interface_mapping * mapping)
4735	{
4736	gfc_formal_arglist *f;
4737	gfc_actual_arglist *actual;
4738
4739	actual = expr->value.function.actual;
4740	f = gfc_sym_get_dummy_args (map_expr->symtree->n.sym);
4741
4742	for (; f && actual; f = f->next, actual = actual->next)
4743	{
4744	if (!actual->expr)
4745	continue;
4746
4747	gfc_add_interface_mapping (mapping, f->sym, NULL__null, actual->expr);
4748	}
4749
4750	if (map_expr->symtree->n.sym->attr.dimension)
4751	{
4752	int d;
4753	gfc_array_spec *as;
4754
4755	as = gfc_copy_array_spec (map_expr->symtree->n.sym->as);
4756
4757	for (d = 0; d < as->rank; d++)
4758	{
4759	gfc_apply_interface_mapping_to_expr (mapping, as->lower[d]);
4760	gfc_apply_interface_mapping_to_expr (mapping, as->upper[d]);
4761	}
4762
4763	expr->value.function.esym->as = as;
4764	}
4765
4766	if (map_expr->symtree->n.sym->ts.type == BT_CHARACTER)
4767	{
4768	expr->value.function.esym->ts.u.cl->length
4769	= gfc_copy_expr (map_expr->symtree->n.sym->ts.u.cl->length);
4770
4771	gfc_apply_interface_mapping_to_expr (mapping,
4772	expr->value.function.esym->ts.u.cl->length);
4773	}
4774	}
4775
4776
4777	/* EXPR is a copy of an expression that appeared in the interface
4778	associated with MAPPING. Walk it recursively looking for references to
4779	dummy arguments that MAPPING maps to actual arguments. Replace each such
4780	reference with a reference to the associated actual argument. */
4781
4782	static void
4783	gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
4784	gfc_expr * expr)
4785	{
4786	gfc_interface_sym_mapping *sym;
4787	gfc_actual_arglist *actual;
4788
4789	if (!expr)
4790	return;
4791
4792	/* Copying an expression does not copy its length, so do that here. */
4793	if (expr->ts.type == BT_CHARACTER && expr->ts.u.cl)
4794	{
4795	expr->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.u.cl);
4796	gfc_apply_interface_mapping_to_expr (mapping, expr->ts.u.cl->length);
4797	}
4798
4799	/* Apply the mapping to any references. */
4800	gfc_apply_interface_mapping_to_ref (mapping, expr->ref);
4801
4802	/* ...and to the expression's symbol, if it has one. */
4803	/* TODO Find out why the condition on expr->symtree had to be moved into
4804	the loop rather than being outside it, as originally. */
4805	for (sym = mapping->syms; sym; sym = sym->next)
4806	if (expr->symtree && sym->old == expr->symtree->n.sym)
4807	{
4808	if (sym->new_sym->n.sym->backend_decl)
4809	expr->symtree = sym->new_sym;
4810	else if (sym->expr)
4811	gfc_replace_expr (expr, gfc_copy_expr (sym->expr));
4812	}
4813
4814	/* ...and to subexpressions in expr->value. */
4815	switch (expr->expr_type)
4816	{
4817	case EXPR_VARIABLE:
4818	case EXPR_CONSTANT:
4819	case EXPR_NULL:
4820	case EXPR_SUBSTRING:
4821	break;
4822
4823	case EXPR_OP:
4824	gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op1);
4825	gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op2);
4826	break;
4827
4828	case EXPR_FUNCTION:
4829	for (actual = expr->value.function.actual; actual; actual = actual->next)
4830	gfc_apply_interface_mapping_to_expr (mapping, actual->expr);
4831
4832	if (expr->value.function.esym == NULL__null
4833	&& expr->value.function.isym != NULL__null
4834	&& expr->value.function.actual
4835	&& expr->value.function.actual->expr
4836	&& expr->value.function.actual->expr->symtree
4837	&& gfc_map_intrinsic_function (expr, mapping))
4838	break;
4839
4840	for (sym = mapping->syms; sym; sym = sym->next)
4841	if (sym->old == expr->value.function.esym)
4842	{
4843	expr->value.function.esym = sym->new_sym->n.sym;
4844	gfc_map_fcn_formal_to_actual (expr, sym->expr, mapping);
4845	expr->value.function.esym->result = sym->new_sym->n.sym;
4846	}
4847	break;
4848
4849	case EXPR_ARRAY:
4850	case EXPR_STRUCTURE:
4851	gfc_apply_interface_mapping_to_cons (mapping, expr->value.constructor);
4852	break;
4853
4854	case EXPR_COMPCALL:
4855	case EXPR_PPC:
4856	case EXPR_UNKNOWN:
4857	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4857, __FUNCTION__));
4858	break;
4859	}
4860
4861	return;
4862	}
4863
4864
4865	/* Evaluate interface expression EXPR using MAPPING. Store the result
4866	in SE. */
4867
4868	void
4869	gfc_apply_interface_mapping (gfc_interface_mapping * mapping,
4870	gfc_se * se, gfc_expr * expr)
4871	{
4872	expr = gfc_copy_expr (expr);
4873	gfc_apply_interface_mapping_to_expr (mapping, expr);
4874	gfc_conv_expr (se, expr);
4875	se->expr = gfc_evaluate_now (se->expr, &se->pre);
4876	gfc_free_expr (expr);
4877	}
4878
4879
4880	/* Returns a reference to a temporary array into which a component of
4881	an actual argument derived type array is copied and then returned
4882	after the function call. */
4883	void
4884	gfc_conv_subref_array_arg (gfc_se se, gfc_expr expr, int g77,
4885	sym_intent intent, bool formal_ptr,
4886	const gfc_symbol fsym, const char proc_name,
4887	gfc_symbol *sym, bool check_contiguous)
4888	{
4889	gfc_se lse;
4890	gfc_se rse;
4891	gfc_ss *lss;
4892	gfc_ss *rss;
4893	gfc_loopinfo loop;
4894	gfc_loopinfo loop2;
4895	gfc_array_info *info;
4896	tree offset;
4897	tree tmp_index;
4898	tree tmp;
4899	tree base_type;
4900	tree size;
4901	stmtblock_t body;
4902	int n;
4903	int dimen;
4904	gfc_se work_se;
4905	gfc_se *parmse;
4906	bool pass_optional;
4907
4908	pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
4909
4910	if (pass_optional \|\| check_contiguous)
4911	{
4912	gfc_init_se (&work_se, NULL__null);
4913	parmse = &work_se;
4914	}
4915	else
4916	parmse = se;
4917
4918	if (gfc_option.rtcheck & GFC_RTCHECK_ARRAY_TEMPS(1<<1))
4919	{
4920	/* We will create a temporary array, so let us warn. */
4921	char * msg;
4922
4923	if (fsym && proc_name)
4924	msg = xasprintf ("An array temporary was created for argument "
4925	"'%s' of procedure '%s'", fsym->name, proc_name);
4926	else
4927	msg = xasprintf ("An array temporary was created");
4928
4929	tmp = build_int_cst (logical_type_node, 1);
4930	gfc_trans_runtime_check (false, true, tmp, &parmse->pre,
4931	&expr->where, msg);
4932	free (msg);
4933	}
4934
4935	gfc_init_se (&lse, NULL__null);
4936	gfc_init_se (&rse, NULL__null);
4937
4938	/* Walk the argument expression. */
4939	rss = gfc_walk_expr (expr);
4940
4941	gcc_assert (rss != gfc_ss_terminator)((void)(!(rss != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4941, __FUNCTION__), 0 : 0));
4942
4943	/* Initialize the scalarizer. */
4944	gfc_init_loopinfo (&loop);
4945	gfc_add_ss_to_loop (&loop, rss);
4946
4947	/* Calculate the bounds of the scalarization. */
4948	gfc_conv_ss_startstride (&loop);
4949
4950	/* Build an ss for the temporary. */
4951	if (expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->backend_decl)
4952	gfc_conv_string_length (expr->ts.u.cl, expr, &parmse->pre);
4953
4954	base_type = gfc_typenode_for_spec (&expr->ts);
4955	if (GFC_ARRAY_TYPE_P (base_type)((tree_class_check ((base_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4955, __FUNCTION__))->type_common.lang_flag_2)
4956	\|\| GFC_DESCRIPTOR_TYPE_P (base_type)((tree_class_check ((base_type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 4956, __FUNCTION__))->type_common.lang_flag_1))
4957	base_type = gfc_get_element_type (base_type);
4958
4959	if (expr->ts.type == BT_CLASS)
4960	base_type = gfc_typenode_for_spec (&CLASS_DATA (expr)expr->ts.u.derived->components->ts);
4961
4962	loop.temp_ss = gfc_get_temp_ss (base_type, ((expr->ts.type == BT_CHARACTER)
4963	? expr->ts.u.cl->backend_decl
4964	: NULL__null),
4965	loop.dimen);
4966
4967	parmse->string_length = loop.temp_ss->info->string_length;
4968
4969	/* Associate the SS with the loop. */
4970	gfc_add_ss_to_loop (&loop, loop.temp_ss);
4971
4972	/* Setup the scalarizing loops. */
4973	gfc_conv_loop_setup (&loop, &expr->where);
4974
4975	/* Pass the temporary descriptor back to the caller. */
4976	info = &loop.temp_ss->info->data.array;
4977	parmse->expr = info->descriptor;
4978
4979	/* Setup the gfc_se structures. */
4980	gfc_copy_loopinfo_to_se (&lse, &loop);
4981	gfc_copy_loopinfo_to_se (&rse, &loop);
4982
4983	rse.ss = rss;
4984	lse.ss = loop.temp_ss;
4985	gfc_mark_ss_chain_used (rss, 1);
4986	gfc_mark_ss_chain_used (loop.temp_ss, 1);
4987
4988	/* Start the scalarized loop body. */
4989	gfc_start_scalarized_body (&loop, &body);
4990
4991	/* Translate the expression. */
4992	gfc_conv_expr (&rse, expr);
4993
4994	/* Reset the offset for the function call since the loop
4995	is zero based on the data pointer. Note that the temp
4996	comes first in the loop chain since it is added second. */
4997	if (gfc_is_class_array_function (expr))
4998	{
4999	tmp = loop.ss->loop_chain->info->data.array.descriptor;
5000	gfc_conv_descriptor_offset_set (&loop.pre, tmp,
5001	gfc_index_zero_nodegfc_rank_cst[0]);
5002	}
5003
5004	gfc_conv_tmp_array_ref (&lse);
5005
5006	if (intent != INTENT_OUT)
5007	{
5008	tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false);
5009	gfc_add_expr_to_block (&body, tmp);
5010	gcc_assert (rse.ss == gfc_ss_terminator)((void)(!(rse.ss == gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5010, __FUNCTION__), 0 : 0));
5011	gfc_trans_scalarizing_loops (&loop, &body);
5012	}
5013	else
5014	{
5015	/* Make sure that the temporary declaration survives by merging
5016	all the loop declarations into the current context. */
5017	for (n = 0; n < loop.dimen; n++)
5018	{
5019	gfc_merge_block_scope (&body);
5020	body = loop.code[loop.order[n]];
5021	}
5022	gfc_merge_block_scope (&body);
5023	}
5024
5025	/* Add the post block after the second loop, so that any
5026	freeing of allocated memory is done at the right time. */
5027	gfc_add_block_to_block (&parmse->pre, &loop.pre);
5028
5029	/********Copy the temporary back again.*******/
5030
5031	gfc_init_se (&lse, NULL__null);
5032	gfc_init_se (&rse, NULL__null);
5033
5034	/* Walk the argument expression. */
5035	lss = gfc_walk_expr (expr);
5036	rse.ss = loop.temp_ss;
5037	lse.ss = lss;
5038
5039	/* Initialize the scalarizer. */
5040	gfc_init_loopinfo (&loop2);
5041	gfc_add_ss_to_loop (&loop2, lss);
5042
5043	dimen = rse.ss->dimen;
5044
5045	/* Skip the write-out loop for this case. */
5046	if (gfc_is_class_array_function (expr))
5047	goto class_array_fcn;
5048
5049	/* Calculate the bounds of the scalarization. */
5050	gfc_conv_ss_startstride (&loop2);
5051
5052	/* Setup the scalarizing loops. */
5053	gfc_conv_loop_setup (&loop2, &expr->where);
5054
5055	gfc_copy_loopinfo_to_se (&lse, &loop2);
5056	gfc_copy_loopinfo_to_se (&rse, &loop2);
5057
5058	gfc_mark_ss_chain_used (lss, 1);
5059	gfc_mark_ss_chain_used (loop.temp_ss, 1);
5060
5061	/* Declare the variable to hold the temporary offset and start the
5062	scalarized loop body. */
5063	offset = gfc_create_var (gfc_array_index_type, NULL__null);
5064	gfc_start_scalarized_body (&loop2, &body);
5065
5066	/* Build the offsets for the temporary from the loop variables. The
5067	temporary array has lbounds of zero and strides of one in all
5068	dimensions, so this is very simple. The offset is only computed
5069	outside the innermost loop, so the overall transfer could be
5070	optimized further. */
5071	info = &rse.ss->info->data.array;
5072
5073	tmp_index = gfc_index_zero_nodegfc_rank_cst[0];
5074	for (n = dimen - 1; n > 0; n--)
5075	{
5076	tree tmp_str;
5077	tmp = rse.loop->loopvar[n];
5078	tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
5079	tmp, rse.loop->from[n]);
5080	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
5081	tmp, tmp_index);
5082
5083	tmp_str = fold_build2_loc (input_location, MINUS_EXPR,
5084	gfc_array_index_type,
5085	rse.loop->to[n-1], rse.loop->from[n-1]);
5086	tmp_str = fold_build2_loc (input_location, PLUS_EXPR,
5087	gfc_array_index_type,
5088	tmp_str, gfc_index_one_nodegfc_rank_cst[1]);
5089
5090	tmp_index = fold_build2_loc (input_location, MULT_EXPR,
5091	gfc_array_index_type, tmp, tmp_str);
5092	}
5093
5094	tmp_index = fold_build2_loc (input_location, MINUS_EXPR,
5095	gfc_array_index_type,
5096	tmp_index, rse.loop->from[0]);
5097	gfc_add_modify (&rse.loop->code[0], offset, tmp_index);
5098
5099	tmp_index = fold_build2_loc (input_location, PLUS_EXPR,
5100	gfc_array_index_type,
5101	rse.loop->loopvar[0], offset);
5102
5103	/* Now use the offset for the reference. */
5104	tmp = build_fold_indirect_ref_loc (input_location,
5105	info->data);
5106	rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL__null);
5107
5108	if (expr->ts.type == BT_CHARACTER)
5109	rse.string_length = expr->ts.u.cl->backend_decl;
5110
5111	gfc_conv_expr (&lse, expr);
5112
5113	gcc_assert (lse.ss == gfc_ss_terminator)((void)(!(lse.ss == gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5113, __FUNCTION__), 0 : 0));
5114
5115	tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, true);
5116	gfc_add_expr_to_block (&body, tmp);
5117
5118	/* Generate the copying loops. */
5119	gfc_trans_scalarizing_loops (&loop2, &body);
5120
5121	/* Wrap the whole thing up by adding the second loop to the post-block
5122	and following it by the post-block of the first loop. In this way,
5123	if the temporary needs freeing, it is done after use! */
5124	if (intent != INTENT_IN)
5125	{
5126	gfc_add_block_to_block (&parmse->post, &loop2.pre);
5127	gfc_add_block_to_block (&parmse->post, &loop2.post);
5128	}
5129
5130	class_array_fcn:
5131
5132	gfc_add_block_to_block (&parmse->post, &loop.post);
5133
5134	gfc_cleanup_loop (&loop);
5135	gfc_cleanup_loop (&loop2);
5136
5137	/* Pass the string length to the argument expression. */
5138	if (expr->ts.type == BT_CHARACTER)
5139	parmse->string_length = expr->ts.u.cl->backend_decl;
5140
5141	/* Determine the offset for pointer formal arguments and set the
5142	lbounds to one. */
5143	if (formal_ptr)
5144	{
5145	size = gfc_index_one_nodegfc_rank_cst[1];
5146	offset = gfc_index_zero_nodegfc_rank_cst[0];
5147	for (n = 0; n < dimen; n++)
5148	{
5149	tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
5150	gfc_rank_cst[n]);
5151	tmp = fold_build2_loc (input_location, PLUS_EXPR,
5152	gfc_array_index_type, tmp,
5153	gfc_index_one_nodegfc_rank_cst[1]);
5154	gfc_conv_descriptor_ubound_set (&parmse->pre,
5155	parmse->expr,
5156	gfc_rank_cst[n],
5157	tmp);
5158	gfc_conv_descriptor_lbound_set (&parmse->pre,
5159	parmse->expr,
5160	gfc_rank_cst[n],
5161	gfc_index_one_nodegfc_rank_cst[1]);
5162	size = gfc_evaluate_now (size, &parmse->pre);
5163	offset = fold_build2_loc (input_location, MINUS_EXPR,
5164	gfc_array_index_type,
5165	offset, size);
5166	offset = gfc_evaluate_now (offset, &parmse->pre);
5167	tmp = fold_build2_loc (input_location, MINUS_EXPR,
5168	gfc_array_index_type,
5169	rse.loop->to[n], rse.loop->from[n]);
5170	tmp = fold_build2_loc (input_location, PLUS_EXPR,
5171	gfc_array_index_type,
5172	tmp, gfc_index_one_nodegfc_rank_cst[1]);
5173	size = fold_build2_loc (input_location, MULT_EXPR,
5174	gfc_array_index_type, size, tmp);
5175	}
5176
5177	gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr,
5178	offset);
5179	}
5180
5181	/* We want either the address for the data or the address of the descriptor,
5182	depending on the mode of passing array arguments. */
5183	if (g77)
5184	parmse->expr = gfc_conv_descriptor_data_get (parmse->expr);
5185	else
5186	parmse->expr = gfc_build_addr_expr (NULL_TREE(tree) __null, parmse->expr);
5187
5188	/* Basically make this into
5189
5190	if (present)
5191	{
5192	if (contiguous)
5193	{
5194	pointer = a;
5195	}
5196	else
5197	{
5198	parmse->pre();
5199	pointer = parmse->expr;
5200	}
5201	}
5202	else
5203	pointer = NULL;
5204
5205	foo (pointer);
5206	if (present && !contiguous)
5207	se->post();
5208
5209	*/
5210
5211	if (pass_optional \|\| check_contiguous)
5212	{
5213	tree type;
5214	stmtblock_t else_block;
5215	tree pre_stmts, post_stmts;
5216	tree pointer;
5217	tree else_stmt;
5218	tree present_var = NULL_TREE(tree) __null;
5219	tree cont_var = NULL_TREE(tree) __null;
5220	tree post_cond;
5221
5222	type = TREE_TYPE (parmse->expr)((contains_struct_check ((parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5222, __FUNCTION__))->typed.type);
5223	if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE \|\| ( (enum tree_code) (type)->base.code) == REFERENCE_TYPE) && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))((tree_class_check ((((contains_struct_check ((type), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5223, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5223, __FUNCTION__))->type_common.lang_flag_1))
5224	type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5224, __FUNCTION__))->typed.type);
5225	pointer = gfc_create_var (type, "arg_ptr");
5226
5227	if (check_contiguous)
5228	{
5229	gfc_se cont_se, array_se;
5230	stmtblock_t if_block, else_block;
5231	tree if_stmt, else_stmt;
5232	mpz_t size;
5233	bool size_set;
5234
5235	cont_var = gfc_create_var (boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], "contiguous");
5236
5237	/* If the size is known to be one at compile-time, set
5238	cont_var to true unconditionally. This may look
5239	inelegant, but we're only doing this during
5240	optimization, so the statements will be optimized away,
5241	and this saves complexity here. */
5242
5243	size_set = gfc_array_size (expr, &size);
5244	if (size_set && mpz_cmp_ui (size, 1)(__builtin_constant_p (1) && (1) == 0 ? ((size)->_mp_size < 0 ? -1 : (size)->_mp_size > 0) : __gmpz_cmp_ui (size ,1)) == 0)
5245	{
5246	gfc_add_modify (&se->pre, cont_var,
5247	build_one_cst (boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]));
5248	}
5249	else
5250	{
5251	/* cont_var = is_contiguous (expr); . */
5252	gfc_init_se (&cont_se, parmse);
5253	gfc_conv_is_contiguous_expr (&cont_se, expr);
5254	gfc_add_block_to_block (&se->pre, &(&cont_se)->pre);
5255	gfc_add_modify (&se->pre, cont_var, cont_se.expr);
5256	gfc_add_block_to_block (&se->pre, &(&cont_se)->post);
5257	}
5258
5259	if (size_set)
5260	mpz_clear__gmpz_clear (size);
5261
5262	/* arrayse->expr = descriptor of a. */
5263	gfc_init_se (&array_se, se);
5264	gfc_conv_expr_descriptor (&array_se, expr);
5265	gfc_add_block_to_block (&se->pre, &(&array_se)->pre);
5266	gfc_add_block_to_block (&se->pre, &(&array_se)->post);
5267
5268	/* if_stmt = { descriptor ? pointer = a : pointer = &a[0]; } . */
5269	gfc_init_block (&if_block);
5270	if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5270, __FUNCTION__))->type_common.lang_flag_1))
5271	gfc_add_modify (&if_block, pointer, array_se.expr);
5272	else
5273	{
5274	tmp = gfc_conv_array_data (array_se.expr);
5275	tmp = fold_convert (type, tmp)fold_convert_loc (((location_t) 0), type, tmp);
5276	gfc_add_modify (&if_block, pointer, tmp);
5277	}
5278	if_stmt = gfc_finish_block (&if_block);
5279
5280	/* else_stmt = { parmse->pre(); pointer = parmse->expr; } . */
5281	gfc_init_block (&else_block);
5282	gfc_add_block_to_block (&else_block, &parmse->pre);
5283	tmp = (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5283, __FUNCTION__))->type_common.lang_flag_1)
5284	? build_fold_indirect_ref_loc (input_location, parmse->expr)
5285	: parmse->expr);
5286	gfc_add_modify (&else_block, pointer, tmp);
5287	else_stmt = gfc_finish_block (&else_block);
5288
5289	/* And put the above into an if statement. */
5290	pre_stmts = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
5291	gfc_likely (cont_var,
5292	PRED_FORTRAN_CONTIGUOUS),
5293	if_stmt, else_stmt);
5294	}
5295	else
5296	{
5297	/* pointer = pramse->expr; . */
5298	gfc_add_modify (&parmse->pre, pointer, parmse->expr);
5299	pre_stmts = gfc_finish_block (&parmse->pre);
5300	}
5301
5302	if (pass_optional)
5303	{
5304	present_var = gfc_create_var (boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], "present");
5305
5306	/* present_var = present(sym); . */
5307	tmp = gfc_conv_expr_present (sym);
5308	tmp = fold_convert (boolean_type_node, tmp)fold_convert_loc (((location_t) 0), global_trees[TI_BOOLEAN_TYPE ], tmp);
5309	gfc_add_modify (&se->pre, present_var, tmp);
5310
5311	/* else_stmt = { pointer = NULL; } . */
5312	gfc_init_block (&else_block);
5313	if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5313, __FUNCTION__))->type_common.lang_flag_1))
5314	gfc_conv_descriptor_data_set (&else_block, pointer,
5315	null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
5316	else
5317	gfc_add_modify (&else_block, pointer, build_int_cst (type, 0));
5318	else_stmt = gfc_finish_block (&else_block);
5319
5320	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
5321	gfc_likely (present_var,
5322	PRED_FORTRAN_ABSENT_DUMMY),
5323	pre_stmts, else_stmt);
5324	gfc_add_expr_to_block (&se->pre, tmp);
5325	}
5326	else
5327	gfc_add_expr_to_block (&se->pre, pre_stmts);
5328
5329	post_stmts = gfc_finish_block (&parmse->post);
5330
5331	/* Put together the post stuff, plus the optional
5332	deallocation. */
5333	if (check_contiguous)
5334	{
5335	/* !cont_var. */
5336	tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE],
5337	cont_var,
5338	build_zero_cst (boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]));
5339	tmp = gfc_unlikely (tmp, PRED_FORTRAN_CONTIGUOUS);
5340
5341	if (pass_optional)
5342	{
5343	tree present_likely = gfc_likely (present_var,
5344	PRED_FORTRAN_ABSENT_DUMMY);
5345	post_cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
5346	boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], present_likely,
5347	tmp);
5348	}
5349	else
5350	post_cond = tmp;
5351	}
5352	else
5353	{
5354	gcc_assert (pass_optional)((void)(!(pass_optional) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5354, __FUNCTION__), 0 : 0));
5355	post_cond = present_var;
5356	}
5357
5358	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], post_cond,
5359	post_stmts, build_empty_stmt (input_location));
5360	gfc_add_expr_to_block (&se->post, tmp);
5361	if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5361, __FUNCTION__))->type_common.lang_flag_1))
5362	{
5363	type = TREE_TYPE (parmse->expr)((contains_struct_check ((parmse->expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5363, __FUNCTION__))->typed.type);
5364	if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE \|\| ( (enum tree_code) (type)->base.code) == REFERENCE_TYPE))
5365	{
5366	pointer = gfc_build_addr_expr (type, pointer);
5367	if (pass_optional)
5368	{
5369	tmp = gfc_likely (present_var, PRED_FORTRAN_ABSENT_DUMMY);
5370	pointer = fold_build3_loc (input_location, COND_EXPR, type,
5371	tmp, pointer,
5372	fold_convert (type,fold_convert_loc (((location_t) 0), type, global_trees[TI_NULL_POINTER ])
5373	null_pointer_node)fold_convert_loc (((location_t) 0), type, global_trees[TI_NULL_POINTER ]));
5374	}
5375	}
5376	else
5377	gcc_assert (!pass_optional)((void)(!(!pass_optional) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5377, __FUNCTION__), 0 : 0));
5378	}
5379	se->expr = pointer;
5380	}
5381
5382	return;
5383	}
5384
5385
5386	/* Generate the code for argument list functions. */
5387
5388	static void
5389	conv_arglist_function (gfc_se se, gfc_expr expr, const char *name)
5390	{
5391	/* Pass by value for g77 %VAL(arg), pass the address
5392	indirectly for %LOC, else by reference. Thus %REF
5393	is a "do-nothing" and %LOC is the same as an F95
5394	pointer. */
5395	if (strcmp (name, "%VAL") == 0)
5396	gfc_conv_expr (se, expr);
5397	else if (strcmp (name, "%LOC") == 0)
5398	{
5399	gfc_conv_expr_reference (se, expr);
5400	se->expr = gfc_build_addr_expr (NULL__null, se->expr);
5401	}
5402	else if (strcmp (name, "%REF") == 0)
5403	gfc_conv_expr_reference (se, expr);
5404	else
5405	gfc_error ("Unknown argument list function at %L", &expr->where);
5406	}
5407
5408
5409	/* This function tells whether the middle-end representation of the expression
5410	E given as input may point to data otherwise accessible through a variable
5411	(sub-)reference.
5412	It is assumed that the only expressions that may alias are variables,
5413	and array constructors if ARRAY_MAY_ALIAS is true and some of its elements
5414	may alias.
5415	This function is used to decide whether freeing an expression's allocatable
5416	components is safe or should be avoided.
5417
5418	If ARRAY_MAY_ALIAS is true, an array constructor may alias if some of
5419	its elements are copied from a variable. This ARRAY_MAY_ALIAS trick
5420	is necessary because for array constructors, aliasing depends on how
5421	the array is used:
5422	- If E is an array constructor used as argument to an elemental procedure,
5423	the array, which is generated through shallow copy by the scalarizer,
5424	is used directly and can alias the expressions it was copied from.
5425	- If E is an array constructor used as argument to a non-elemental
5426	procedure,the scalarizer is used in gfc_conv_expr_descriptor to generate
5427	the array as in the previous case, but then that array is used
5428	to initialize a new descriptor through deep copy. There is no alias
5429	possible in that case.
5430	Thus, the ARRAY_MAY_ALIAS flag is necessary to distinguish the two cases
5431	above. */
5432
5433	static bool
5434	expr_may_alias_variables (gfc_expr *e, bool array_may_alias)
5435	{
5436	gfc_constructor *c;
5437
5438	if (e->expr_type == EXPR_VARIABLE)
5439	return true;
5440	else if (e->expr_type == EXPR_FUNCTION)
5441	{
5442	gfc_symbol *proc_ifc = gfc_get_proc_ifc_for_expr (e);
5443
5444	if (proc_ifc->result != NULL__null
5445	&& ((proc_ifc->result->ts.type == BT_CLASS
5446	&& proc_ifc->result->ts.u.derived->attr.is_class
5447	&& CLASS_DATA (proc_ifc->result)proc_ifc->result->ts.u.derived->components->attr.class_pointer)
5448	\|\| proc_ifc->result->attr.pointer))
5449	return true;
5450	else
5451	return false;
5452	}
5453	else if (e->expr_type != EXPR_ARRAY \|\| !array_may_alias)
5454	return false;
5455
5456	for (c = gfc_constructor_first (e->value.constructor);
5457	c; c = gfc_constructor_next (c))
5458	if (c->expr
5459	&& expr_may_alias_variables (c->expr, array_may_alias))
5460	return true;
5461
5462	return false;
5463	}
5464
5465
5466	/* A helper function to set the dtype for unallocated or unassociated
5467	entities. */
5468
5469	static void
5470	set_dtype_for_unallocated (gfc_se parmse, gfc_expr e)
5471	{
5472	tree tmp;
5473	tree desc;
5474	tree cond;
5475	tree type;
5476	stmtblock_t block;
5477
5478	/* TODO Figure out how to handle optional dummies. */
5479	if (e && e->expr_type == EXPR_VARIABLE
5480	&& e->symtree->n.sym->attr.optional)
5481	return;
5482
5483	desc = parmse->expr;
5484	if (desc == NULL_TREE(tree) __null)
5485	return;
5486
5487	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-expr.cc" , 5487, __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-expr.cc" , 5487, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
5488	desc = build_fold_indirect_ref_loc (input_location, desc);
5489	if (GFC_CLASS_TYPE_P (TREE_TYPE (desc))((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5489, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5489, __FUNCTION__))->type_common.lang_flag_4))
5490	desc = gfc_class_data_get (desc);
5491	if (!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-expr.cc" , 5491, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5491, __FUNCTION__))->type_common.lang_flag_1))
5492	return;
5493
5494	gfc_init_block (&block);
5495	tmp = gfc_conv_descriptor_data_get (desc);
5496	cond = fold_build2_loc (input_location, EQ_EXPR,
5497	logical_type_node, tmp,
5498	build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5498, __FUNCTION__))->typed.type), 0));
5499	tmp = gfc_conv_descriptor_dtype (desc);
5500	type = gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5500, __FUNCTION__))->typed.type));
5501	tmp = fold_build2_loc (input_location, MODIFY_EXPR,
5502	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5502, __FUNCTION__))->typed.type), tmp,
5503	gfc_get_dtype_rank_type (e->rank, type));
5504	gfc_add_expr_to_block (&block, tmp);
5505	cond = build3_v (COND_EXPR, cond,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, gfc_finish_block (&block), build_empty_stmt (input_location ))
5506	gfc_finish_block (&block),fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, gfc_finish_block (&block), build_empty_stmt (input_location ))
5507	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cond, gfc_finish_block (&block), build_empty_stmt (input_location ));
5508	gfc_add_expr_to_block (&parmse->pre, cond);
5509	}
5510
5511
5512
5513	/* Provide an interface between gfortran array descriptors and the F2018:18.4
5514	ISO_Fortran_binding array descriptors. */
5515
5516	static void
5517	gfc_conv_gfc_desc_to_cfi_desc (gfc_se parmse, gfc_expr e, gfc_symbol *fsym)
5518	{
5519	stmtblock_t block, block2;
5520	tree cfi, gfc, tmp, tmp2;
5521	tree present = NULL__null;
5522	tree gfc_strlen = NULL__null;
5523	tree rank;
5524	gfc_se se;
5525
5526	if (fsym->attr.optional
5527	&& e->expr_type == EXPR_VARIABLE
5528	&& e->symtree->n.sym->attr.optional)
5529	present = gfc_conv_expr_present (e->symtree->n.sym);
5530
5531	gfc_init_block (&block);
5532
5533	/* Convert original argument to a tree. */
5534	gfc_init_se (&se, NULL__null);
5535	if (e->rank == 0)
5536	{
5537	se.want_pointer = 1;
5538	gfc_conv_expr (&se, e);
5539	gfc = se.expr;
5540	/* gfc_conv_constant ignores se.want_poiner, e.g. for string_cst. */
5541	if (!POINTER_TYPE_P (TREE_TYPE (gfc))(((enum tree_code) (((contains_struct_check ((gfc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5541, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((gfc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5541, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
5542	gfc = gfc_build_addr_expr (NULL__null, gfc);
5543	}
5544	else
5545	{
5546	/* If the actual argument can be noncontiguous, copy-in/out is required,
5547	if the dummy has either the CONTIGUOUS attribute or is an assumed-
5548	length assumed-length/assumed-size CHARACTER array. This only
5549	applies if the actual argument is a "variable"; if it's some
5550	non-lvalue expression, we are going to evaluate it to a
5551	temporary below anyway. */
5552	se.force_no_tmp = 1;
5553	if ((fsym->attr.contiguous
5554	\|\| (fsym->ts.type == BT_CHARACTER && !fsym->ts.u.cl->length
5555	&& (fsym->as->type == AS_ASSUMED_SIZE
5556	\|\| fsym->as->type == AS_EXPLICIT)))
5557	&& !gfc_is_simply_contiguous (e, false, true)
5558	&& gfc_expr_is_variable (e))
5559	{
5560	bool optional = fsym->attr.optional;
5561	fsym->attr.optional = 0;
5562	gfc_conv_subref_array_arg (&se, e, false, fsym->attr.intent,
5563	fsym->attr.pointer, fsym,
5564	fsym->ns->proc_name->name, NULL__null,
5565	/* check_contiguous= */ true);
5566	fsym->attr.optional = optional;
5567	}
5568	else
5569	gfc_conv_expr_descriptor (&se, e);
5570	gfc = se.expr;
5571	/* For dt(:)%var the elem_len*stride != sm, hence, GFC uses
5572	elem_len = sizeof(dt) and base_addr = dt(lb) instead.
5573	gfc_get_dataptr_offset fixes the base_addr; for elem_len, see below.
5574	While sm is fine as it uses spanstride and not elem_len. /
5575	if (POINTER_TYPE_P (TREE_TYPE (gfc))(((enum tree_code) (((contains_struct_check ((gfc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5575, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((gfc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5575, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
5576	gfc = build_fold_indirect_ref_loc (input_location, gfc);
5577	else if (is_subref_array (e) && e->ts.type != BT_CHARACTER)
5578	gfc_get_dataptr_offset (&se.pre, gfc, gfc, NULL__null, true, e);
5579	}
5580	if (e->ts.type == BT_CHARACTER)
5581	{
5582	if (se.string_length)
5583	gfc_strlen = se.string_length;
5584	else if (e->ts.u.cl->backend_decl)
5585	gfc_strlen = e->ts.u.cl->backend_decl;
5586	else
5587	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5587, __FUNCTION__));
5588	}
5589	gfc_add_block_to_block (&block, &se.pre);
5590
5591	/* Create array decriptor and set version, rank, attribute, type. */
5592	cfi = gfc_create_var (gfc_get_cfi_type (e->rank < 0
5593	? GFC_MAX_DIMENSIONS15 : e->rank,
5594	false), "cfi");
5595	/* Convert to CFI_cdesc_t, which has dim[] to avoid TBAA issues,*/
5596	if (fsym->attr.dimension && fsym->as->type == AS_ASSUMED_RANK)
5597	{
5598	tmp = gfc_get_cfi_type (-1, !fsym->attr.pointer && !fsym->attr.target);
5599	tmp = build_pointer_type (tmp);
5600	parmse->expr = cfi = gfc_build_addr_expr (tmp, cfi);
5601	cfi = build_fold_indirect_ref_loc (input_location, cfi);
5602	}
5603	else
5604	parmse->expr = gfc_build_addr_expr (NULL__null, cfi);
5605
5606	tmp = gfc_get_cfi_desc_version (cfi);
5607	gfc_add_modify (&block, tmp,
5608	build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5608, __FUNCTION__))->typed.type), CFI_VERSION1));
5609	if (e->rank < 0)
5610	rank = fold_convert (signed_char_type_node, gfc_conv_descriptor_rank (gfc))fold_convert_loc (((location_t) 0), integer_types[itk_signed_char ], gfc_conv_descriptor_rank (gfc));
5611	else
5612	rank = build_int_cst (signed_char_type_nodeinteger_types[itk_signed_char], e->rank);
5613	tmp = gfc_get_cfi_desc_rank (cfi);
5614	gfc_add_modify (&block, tmp, rank);
5615	int itype = CFI_type_other-1;
5616	if (e->ts.f90_type == BT_VOID)
5617	itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
5618	? CFI_type_cfunptr8 : CFI_type_cptr7);
5619	else
5620	{
5621	if (e->expr_type == EXPR_NULL && e->ts.type == BT_UNKNOWN)
5622	e->ts = fsym->ts;
5623	switch (e->ts.type)
5624	{
5625	case BT_INTEGER:
5626	case BT_LOGICAL:
5627	case BT_REAL:
5628	case BT_COMPLEX:
5629	itype = CFI_type_from_type_kind (e->ts.type, e->ts.kind)(e->ts.type + (e->ts.kind << 8));
5630	break;
5631	case BT_CHARACTER:
5632	itype = CFI_type_from_type_kind (CFI_type_Character, e->ts.kind)(5 + (e->ts.kind << 8));
5633	break;
5634	case BT_DERIVED:
5635	itype = CFI_type_struct6;
5636	break;
5637	case BT_VOID:
5638	itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
5639	? CFI_type_cfunptr8 : CFI_type_cptr7);
5640	break;
5641	case BT_ASSUMED:
5642	itype = CFI_type_other-1; // FIXME: Or CFI_type_cptr ?
5643	break;
5644	case BT_CLASS:
5645	if (UNLIMITED_POLY (e)(e != __null && e->ts.type == BT_CLASS && e ->ts.u.derived->components && e->ts.u.derived ->components->ts.u.derived && e->ts.u.derived ->components->ts.u.derived->attr.unlimited_polymorphic ) && fsym->ts.type == BT_ASSUMED)
5646	{
5647	// F2017: 7.3.2.2: "An entity that is declared using the TYPE(*)
5648	// type specifier is assumed-type and is an unlimited polymorphic
5649	// entity." The actual argument _data component is passed.
5650	itype = CFI_type_other-1; // FIXME: Or CFI_type_cptr ?
5651	break;
5652	}
5653	else
5654	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5654, __FUNCTION__));
5655	case BT_PROCEDURE:
5656	case BT_HOLLERITH:
5657	case BT_UNION:
5658	case BT_BOZ:
5659	case BT_UNKNOWN:
5660	// FIXME: Really unreachable? Or reachable for type(*) ? If so, CFI_type_other?
5661	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5661, __FUNCTION__));
5662	}
5663	}
5664
5665	tmp = gfc_get_cfi_desc_type (cfi);
5666	gfc_add_modify (&block, tmp,
5667	build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5667, __FUNCTION__))->typed.type), itype));
5668
5669	int attr = CFI_attribute_other2;
5670	if (fsym->attr.pointer)
5671	attr = CFI_attribute_pointer0;
5672	else if (fsym->attr.allocatable)
5673	attr = CFI_attribute_allocatable1;
5674	tmp = gfc_get_cfi_desc_attribute (cfi);
5675	gfc_add_modify (&block, tmp,
5676	build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5676, __FUNCTION__))->typed.type), attr));
5677
5678	/* The cfi-base_addr assignment could be skipped for 'pointer, intent(out)'.
5679	That is very sensible for undefined pointers, but the C code might assume
5680	that the pointer retains the value, in particular, if it was NULL. */
5681	if (e->rank == 0)
5682	{
5683	tmp = gfc_get_cfi_desc_base_addr (cfi);
5684	gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), gfc)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5684, __FUNCTION__))->typed.type), gfc));
5685	}
5686	else
5687	{
5688	tmp = gfc_get_cfi_desc_base_addr (cfi);
5689	tmp2 = gfc_conv_descriptor_data_get (gfc);
5690	gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), tmp2)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5690, __FUNCTION__))->typed.type), tmp2));
5691	}
5692
5693	/* Set elem_len if known - must be before the next if block.
5694	Note that allocatable implies 'len=:'. */
5695	if (e->ts.type != BT_ASSUMED && e->ts.type != BT_CHARACTER )
5696	{
5697	/* Length is known at compile time; use 'block' for it. */
5698	tmp = size_in_bytes (gfc_typenode_for_spec (&e->ts));
5699	tmp2 = gfc_get_cfi_desc_elem_len (cfi);
5700	gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5700, __FUNCTION__))->typed.type), tmp));
5701	}
5702
5703	if (fsym->attr.pointer && fsym->attr.intent == INTENT_OUT)
5704	goto done;
5705
5706	/* When allocatable + intent out, free the cfi descriptor. */
5707	if (fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT)
5708	{
5709	tmp = gfc_get_cfi_desc_base_addr (cfi);
5710	tree call = builtin_decl_explicit (BUILT_IN_FREE);
5711	call = build_call_expr_loc (input_location, call, 1, tmp);
5712	gfc_add_expr_to_block (&block, fold_convert (void_type_node, call)fold_convert_loc (((location_t) 0), global_trees[TI_VOID_TYPE ], call));
5713	gfc_add_modify (&block, tmp,
5714	fold_convert (TREE_TYPE (tmp), null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5714, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
5715	goto done;
5716	}
5717
5718	/* If not unallocated/unassociated. */
5719	gfc_init_block (&block2);
5720
5721	/* Set elem_len, which may be only known at run time. */
5722	if (e->ts.type == BT_CHARACTER
5723	&& (e->expr_type != EXPR_NULL \|\| gfc_strlen != NULL_TREE(tree) __null))
5724	{
5725	gcc_assert (gfc_strlen)((void)(!(gfc_strlen) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5725, __FUNCTION__), 0 : 0));
5726	tmp = gfc_strlen;
5727	if (e->ts.kind != 1)
5728	tmp = fold_build2_loc (input_location, MULT_EXPR,
5729	gfc_charlen_type_node, tmp,
5730	build_int_cst (gfc_charlen_type_node,
5731	e->ts.kind));
5732	tmp2 = gfc_get_cfi_desc_elem_len (cfi);
5733	gfc_add_modify (&block2, tmp2, fold_convert (TREE_TYPE (tmp2), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5733, __FUNCTION__))->typed.type), tmp));
5734	}
5735	else if (e->ts.type == BT_ASSUMED)
5736	{
5737	tmp = gfc_conv_descriptor_elem_len (gfc);
5738	tmp2 = gfc_get_cfi_desc_elem_len (cfi);
5739	gfc_add_modify (&block2, tmp2, fold_convert (TREE_TYPE (tmp2), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5739, __FUNCTION__))->typed.type), tmp));
5740	}
5741
5742	if (e->ts.type == BT_ASSUMED)
5743	{
5744	/* Note: type(*) implies assumed-shape/assumed-rank if fsym requires
5745	an CFI descriptor. Use the type in the descritor as it provide
5746	mode information. (Quality of implementation feature.) */
5747	tree cond;
5748	tree ctype = gfc_get_cfi_desc_type (cfi);
5749	tree type = fold_convert (TREE_TYPE (ctype),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5749, __FUNCTION__))->typed.type), gfc_conv_descriptor_type (gfc))
5750	gfc_conv_descriptor_type (gfc))fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5749, __FUNCTION__))->typed.type), gfc_conv_descriptor_type (gfc));
5751	tree kind = fold_convert (TREE_TYPE (ctype),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (ctype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-expr.cc" , 5751, __FUNCTION__))->