se->expr = tmp;
- if (c->ts.type == BT_CHARACTER)
+ if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer)
{
tmp = c->ts.u.cl->backend_decl;
/* Components must always be constant length. */
separately. */
if (se->want_pointer)
{
- if (expr->ts.type == BT_CHARACTER)
+ if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr, NULL))
gfc_conv_string_parameter (se);
else
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
gfc_init_block (&post);
gfc_init_interface_mapping (&mapping);
- need_interface_mapping = ((sym->ts.type == BT_CHARACTER
- && sym->ts.u.cl->length
- && sym->ts.u.cl->length->expr_type
- != EXPR_CONSTANT)
- || (comp && comp->attr.dimension)
- || (!comp && sym->attr.dimension));
- if (comp)
- formal = comp->formal;
+ if (!comp)
+ {
+ formal = sym->formal;
+ need_interface_mapping = sym->attr.dimension ||
+ (sym->ts.type == BT_CHARACTER
+ && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type
+ != EXPR_CONSTANT);
+ }
else
- formal = sym->formal;
+ {
+ formal = comp->formal;
+ need_interface_mapping = comp->attr.dimension ||
+ (comp->ts.type == BT_CHARACTER
+ && comp->ts.u.cl->length
+ && comp->ts.u.cl->length->expr_type
+ != EXPR_CONSTANT);
+ }
+
/* Evaluate the arguments. */
for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
{
}
gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
- ts = sym->ts;
+ if (comp)
+ ts = comp->ts;
+ else
+ ts = sym->ts;
+
if (ts.type == BT_CHARACTER && sym->attr.is_bind_c)
se->string_length = build_int_cst (gfc_charlen_type_node, 1);
else if (ts.type == BT_CHARACTER)
{
- if (sym->ts.u.cl->length == NULL)
+ if (ts.u.cl->length == NULL)
{
/* Assumed character length results are not allowed by 5.1.1.5 of the
standard and are trapped in resolve.c; except in the case of SPREAD
/* Calculate the length of the returned string. */
gfc_init_se (&parmse, NULL);
if (need_interface_mapping)
- gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.u.cl->length);
+ gfc_apply_interface_mapping (&mapping, &parmse, ts.u.cl->length);
else
- gfc_conv_expr (&parmse, sym->ts.u.cl->length);
+ 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);
len = cl.backend_decl;
}
- byref = (comp && comp->attr.dimension)
+ byref = (comp && (comp->attr.dimension || comp->ts.type == BT_CHARACTER))
|| (!comp && gfc_return_by_reference (sym));
if (byref)
{
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
retargs = gfc_chainon_list (retargs, tmp);
}
- else if (sym->result->attr.dimension)
+ else if (!comp && sym->result->attr.dimension)
{
gcc_assert (se->loop && info);
/* Return an address to a char[0:len-1]* temporary for
character pointers. */
- if (sym->attr.pointer || sym->attr.allocatable)
+ if ((!comp && (sym->attr.pointer || sym->attr.allocatable))
+ || (comp && (comp->attr.pointer || comp->attr.allocatable)))
{
var = gfc_create_var (type, "pstr");
/* Bundle in the string length. */
se->string_length = len;
}
- else if (sym->ts.type == BT_CHARACTER)
+ else if (ts.type == BT_CHARACTER)
{
/* Dereference for character pointer results. */
- if (sym->attr.pointer || sym->attr.allocatable)
- se->expr = build_fold_indirect_ref_loc (input_location,
- var);
+ if ((!comp && (sym->attr.pointer || sym->attr.allocatable))
+ || (comp && (comp->attr.pointer || comp->attr.allocatable)))
+ se->expr = build_fold_indirect_ref_loc (input_location, var);
else
se->expr = var;
}
else
{
- gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
- se->expr = build_fold_indirect_ref_loc (input_location,
- var);
+ gcc_assert (ts.type == BT_COMPLEX && gfc_option.flag_f2c);
+ se->expr = build_fold_indirect_ref_loc (input_location, var);
}
}
}
/* Check character lengths if character expression. The test is only
really added if -fbounds-check is enabled. */
- if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
+ if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL
+ && !expr1->symtree->n.sym->attr.proc_pointer
+ && !gfc_is_proc_ptr_comp (expr1, NULL))
{
gcc_assert (expr2->ts.type == BT_CHARACTER);
gcc_assert (lse.string_length && rse.string_length);