tmp = gfc_get_int_type (kind);
tmp = fold_convert (tmp, build_fold_indirect_ref_loc (input_location,
se->expr));
-
+
/* Test for a NULL value. */
tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), present,
tmp, fold_convert (TREE_TYPE (tmp), integer_one_node));
gfc_ref *r;
tree length;
- gcc_assert (e->expr_type == EXPR_VARIABLE
+ gcc_assert (e->expr_type == EXPR_VARIABLE
&& e->ts.type == BT_CHARACTER);
-
+
length = NULL; /* To silence compiler warning. */
if (is_subref_array (e) && e->ts.u.cl->length)
{
case EXPR_OP:
- flatten_array_ctors_without_strlen (e->value.op.op1);
- flatten_array_ctors_without_strlen (e->value.op.op2);
+ flatten_array_ctors_without_strlen (e->value.op.op1);
+ flatten_array_ctors_without_strlen (e->value.op.op2);
break;
case EXPR_COMPCALL:
se_expr = gfc_get_fake_result_decl (sym, parent_flag);
/* Similarly for alternate entry points. */
- else if (alternate_entry
+ else if (alternate_entry
&& (sym->ns->proc_name->backend_decl == current_function_decl
|| parent_flag))
{
/* Dereference the expression, where needed. Since characters
- are entirely different from other types, they are treated
+ are entirely different from other types, they are treated
separately. */
if (sym->ts.type == BT_CHARACTER)
{
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
- /* Dereference non-character pointer variables.
+ /* Dereference non-character pointer variables.
These must be dummies, results, or scalars. */
if ((sym->attr.pointer || sym->attr.allocatable
|| gfc_is_associate_pointer (sym))
{
if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr, NULL))
gfc_conv_string_parameter (se);
- else
+ else
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
}
}
124, 166, 125, 214, 126, 138, 127, 153, /* 248 - 255 */
};
-/* If n is larger than lookup table's max index, we use the "window
+/* If n is larger than lookup table's max index, we use the "window
method". */
#define POWI_WINDOW_SIZE 3
-/* Recursive function to expand the power operator. The temporary
+/* Recursive function to expand the power operator. The temporary
values are put in tmpvar. The function returns tmpvar[1] ** n. */
static tree
gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INT n, tree * tmpvar)
/* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care
of the asymmetric range of the integer type. */
n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m);
-
+
type = TREE_TYPE (lhs);
sgn = tree_int_cst_sgn (rhs);
case 4:
ikind = 0;
break;
-
+
case 8:
ikind = 1;
break;
case 4:
kind = 0;
break;
-
+
case 8:
kind = 1;
break;
default:
gcc_unreachable ();
}
-
+
switch (expr->value.op.op1->ts.type)
{
case BT_INTEGER:
case 0:
fndecl = built_in_decls[BUILT_IN_POWIF];
break;
-
+
case 1:
fndecl = built_in_decls[BUILT_IN_POWI];
break;
break;
case 3:
- /* Use the __builtin_powil() only if real(kind=16) is
+ /* Use the __builtin_powil() only if real(kind=16) is
actually the C long double type. */
if (!gfc_real16_is_float128)
fndecl = built_in_decls[BUILT_IN_POWIL];
}
}
- /* If we don't have a good builtin for this, go for the
+ /* If we don't have a good builtin for this, go for the
library function. */
if (!fndecl)
fndecl = gfor_fndecl_math_powi[kind][ikind].real;
(int)(*expr)->value.character.string[0]);
if ((*expr)->ts.kind != gfc_c_int_kind)
{
- /* The expr needs to be compatible with a C int. If the
+ /* The expr needs to be compatible with a C int. If the
conversion fails, then the 2 causes an ICE. */
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
else if (!sym->attr.dimension || sym->attr.pointer || sym->attr.allocatable)
value = build_fold_indirect_ref_loc (input_location,
se->expr);
-
- /* For character(*), use the actual argument's descriptor. */
+
+ /* For character(*), use the actual argument's descriptor. */
else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.u.cl->length)
value = build_fold_indirect_ref_loc (input_location,
se->expr);
rss = gfc_walk_expr (expr);
gcc_assert (rss != gfc_ss_terminator);
-
+
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, rss);
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false, true);
gfc_add_expr_to_block (&body, tmp);
-
+
/* Generate the copying loops. */
gfc_trans_scalarizing_loops (&loop2, &body);
if (formal_ptr)
{
size = gfc_index_one_node;
- offset = gfc_index_zero_node;
+ offset = gfc_index_zero_node;
for (n = 0; n < dimen; n++)
{
tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
/* Takes a derived type expression and returns the address of a temporary
- class object of the 'declared' type. */
+ class object of the 'declared' type. */
static void
gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_typespec class_ts)
{
gfc_symbol *fsym;
gfc_ss *argss;
-
+
if (sym->intmod_sym_id == ISOCBINDING_LOC)
{
if (arg->expr->rank == 0)
&& !(fsym->attr.pointer || fsym->attr.allocatable)
&& fsym->as->type != AS_ASSUMED_SHAPE;
f = f || !sym->attr.always_explicit;
-
+
argss = gfc_walk_expr (arg->expr);
gfc_conv_array_parameter (se, arg->expr, argss, f,
NULL, NULL, NULL);
arg->expr->ts.f90_type = sym->ts.u.derived->ts.f90_type;
arg->expr->ts.kind = sym->ts.u.derived->ts.kind;
gfc_conv_expr_reference (se, arg->expr);
-
+
return 1;
}
else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER
gfc_conv_expr (&fptrse, arg->next->expr);
gfc_add_block_to_block (&se->pre, &fptrse.pre);
gfc_add_block_to_block (&se->post, &fptrse.post);
-
+
if (arg->next->expr->symtree->n.sym->attr.proc_pointer
&& arg->next->expr->symtree->n.sym->attr.dummy)
fptrse.expr = build_fold_indirect_ref_loc (input_location,
fptrse.expr);
-
+
se->expr = fold_build2_loc (input_location, MODIFY_EXPR,
TREE_TYPE (fptrse.expr),
fptrse.expr,
{
tree eq_expr;
tree not_null_expr;
-
+
/* Given two arguments so build the arg2se from second arg. */
gfc_init_se (&arg2se, NULL);
gfc_conv_expr (&arg2se, arg->next->expr);
return 1;
}
-
+
/* Nothing was done. */
return 0;
}
/* An elemental function inside a scalarized loop. */
gfc_init_se (&parmse, se);
gfc_conv_expr_reference (&parmse, e);
+ if (e->ts.type == BT_CHARACTER && !e->rank
+ && e->expr_type == EXPR_FUNCTION)
+ parmse.expr = build_fold_indirect_ref_loc (input_location,
+ parmse.expr);
parm_kind = ELEMENTAL;
}
else
{
gfc_conv_expr_reference (&parmse, e);
- /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
+ /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
if (fsym && fsym->attr.allocatable
&& fsym->attr.intent == INTENT_OUT)
/* If the argument is a function call that may not create
a temporary for the result, we have to check that we
- can do it, i.e. that there is no alias between this
+ can do it, i.e. that there is no alias between this
argument and another one. */
if (gfc_get_noncopying_intrinsic_argument (e) != NULL)
{
gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
sym->name, NULL);
- /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
+ /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
if (fsym && fsym->attr.allocatable
&& fsym->attr.intent == INTENT_OUT)
tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (&se->pre, tmp);
}
- }
+ }
}
/* The case with fsym->attr.optional is that of a user subroutine
&& ((e->rank > 0 && sym->attr.elemental)
|| e->representation.length || e->ts.type == BT_CHARACTER
|| (e->rank > 0
- && (fsym == NULL
+ && (fsym == NULL
|| (fsym-> as
&& (fsym->as->type == AS_ASSUMED_SHAPE
|| fsym->as->type == AS_DEFERRED))))))
fold_convert (TREE_TYPE (tmp),
null_pointer_node));
}
-
+
gfc_trans_runtime_check (true, false, cond, &se->pre, &e->where,
msg);
gfc_free (msg);
gfc_conv_expr (&parmse, ts.u.cl->length);
gfc_add_block_to_block (&se->pre, &parmse.pre);
gfc_add_block_to_block (&se->post, &parmse.post);
-
+
tmp = fold_convert (gfc_charlen_type_node, parmse.expr);
tmp = fold_build2_loc (input_location, MAX_EXPR,
gfc_charlen_type_node, tmp,
/* Build a static initializer. EXPR is the expression for the initial value.
- The other parameters describe the variable of the component being
+ The other parameters describe the variable of the component being
initialized. EXPR may be null. */
tree
gcc_assert (TREE_CODE (se.expr) != CONSTRUCTOR);
return se.expr;
}
-
+
if (array && !procptr)
{
tree ctor;
}
}
}
-
+
static tree
gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
{
cm->as->lower[n]->value.integer);
mpz_add_ui (lss->shape[n], lss->shape[n], 1);
}
-
+
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, lss);
gfc_add_ss_to_loop (&loop, rss);
gfc_start_block (&block);
gfc_init_se (&se, NULL);
- /* Get the descriptor for the expressions. */
+ /* Get the descriptor for the expressions. */
rss = gfc_walk_expr (expr);
se.want_pointer = 0;
gfc_conv_expr_descriptor (&se, expr, rss);
fold_convert (TREE_TYPE (lse.expr), se.expr));
return gfc_finish_block (&block);
- }
+ }
for (c = gfc_constructor_first (expr->value.constructor);
c; c = gfc_constructor_next (c), cm = cm->next)
}
}
se->expr = build_constructor (type, v);
- if (init)
+ if (init)
TREE_CONSTANT (se->expr) = 1;
}
expr->ts.kind = expr->ts.u.derived->ts.kind;
}
}
-
+
switch (expr->expr_type)
{
case EXPR_OP:
for (remap = expr1->ref; remap; remap = remap->next)
if (!remap->next && remap->type == REF_ARRAY
&& remap->u.ar.type == AR_SECTION)
- {
+ {
remap->u.ar.type = AR_FULL;
break;
}
else if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
{
cond = NULL_TREE;
-
+
/* Are the rhs and the lhs the same? */
if (r_is_var)
{
/* Functions returning pointers or allocatables need temporaries. */
c = expr2->value.function.esym
- ? (expr2->value.function.esym->attr.pointer
+ ? (expr2->value.function.esym->attr.pointer
|| expr2->value.function.esym->attr.allocatable)
: (expr2->symtree->n.sym->attr.pointer
|| expr2->symtree->n.sym->attr.allocatable);
correctly take care of the reallocation internally. For intrinsic
calls, the array data is freed and the library takes care of allocation.
TODO: Add logic of trans-array.c: gfc_alloc_allocatable_for_assignment
- to the library. */
+ to the library. */
if (gfc_option.flag_realloc_lhs
&& gfc_is_reallocatable_lhs (expr1)
&& !gfc_expr_attr (expr1).codimension
gfc_init_se (&lse, NULL);
lse.want_pointer = 1;
gfc_conv_expr (&lse, expr1);
-
+
jump_label1 = gfc_build_label_decl (NULL_TREE);
jump_label2 = gfc_build_label_decl (NULL_TREE);
gfc_add_block_to_block (&block, &src.pre);
tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
gfc_add_expr_to_block (&block, tmp);
-
+
return gfc_finish_block (&block);
}
projects / thirdparty / gcc.git / commitdiff
