Fortran: Fix class reallocate on assignment [PR99307].
2021-04-15 Paul Thomas <pault@gcc.gnu.org> gcc/fortran PR fortran/99307 * symbol.c: Remove trailing white space. * trans-array.c (gfc_trans_create_temp_array): Create a class temporary for class expressions and assign the new descriptor to the data field. (build_class_array_ref): If the class expr can be extracted, then use that for 'decl'. Class function results are reliably handled this way. Call gfc_find_and_cut_at_last_class_ref to eliminate largely redundant code. Remove dead code and recast the rest of the code to extract 'decl' for remaining cases. Call gfc_build_spanned_array_ref. (gfc_alloc_allocatable_for_assignment): Use class descriptor element length for 'elemsize1'. Eliminate repeat set of dtype for class expressions. * trans-expr.c (gfc_find_and_cut_at_last_class_ref): Include additional code from build_class_array_ref, and use optional gfc_typespec pointer argument. (gfc_trans_scalar_assign): Make use of pre and post blocks for all class expressions. * trans.c (get_array_span): For unlimited polymorphic exprs multiply the span by the value of the _len field. (gfc_build_spanned_array_ref): New function. (gfc_build_array_ref): Call gfc_build_spanned_array_ref and eliminate repeated code. * trans.h: Add arg to gfc_find_and_cut_at_last_class_ref and add prototype for gfc_build_spanned_array_ref.
This commit is contained in:
Paul Thomas
parent
417c36cfd6
commit
9a0e09f3dd
|
|
@ -4391,7 +4391,7 @@ get_iso_c_binding_dt (int sym_id)
|
|||
if (dt_list->from_intmod != INTMOD_NONE
|
||||
&& dt_list->intmod_sym_id == sym_id)
|
||||
return dt_list;
|
||||
|
||||
|
||||
dt_list = dt_list->dt_next;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1403,9 +1403,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
|
|||
desc = gfc_create_var (type, "atmp");
|
||||
GFC_DECL_PACKED_ARRAY (desc) = 1;
|
||||
|
||||
info->descriptor = desc;
|
||||
size = gfc_index_one_node;
|
||||
|
||||
/* Emit a DECL_EXPR for the variable sized array type in
|
||||
GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
|
||||
sizes works correctly. */
|
||||
|
|
@ -1416,9 +1413,40 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
|
|||
gfc_add_expr_to_block (pre, build1 (DECL_EXPR,
|
||||
arraytype, TYPE_NAME (arraytype)));
|
||||
|
||||
/* Fill in the array dtype. */
|
||||
tmp = gfc_conv_descriptor_dtype (desc);
|
||||
gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
|
||||
if (class_expr != NULL_TREE)
|
||||
{
|
||||
tree class_data;
|
||||
tree dtype;
|
||||
|
||||
/* Create a class temporary. */
|
||||
tmp = gfc_create_var (TREE_TYPE (class_expr), "ctmp");
|
||||
gfc_add_modify (pre, tmp, class_expr);
|
||||
|
||||
/* Assign the new descriptor to the _data field. This allows the
|
||||
vptr _copy to be used for scalarized assignment since the class
|
||||
temporary can be found from the descriptor. */
|
||||
class_data = gfc_class_data_get (tmp);
|
||||
tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
|
||||
TREE_TYPE (desc), desc);
|
||||
gfc_add_modify (pre, class_data, tmp);
|
||||
|
||||
/* Take the dtype from the class expression. */
|
||||
dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
|
||||
tmp = gfc_conv_descriptor_dtype (class_data);
|
||||
gfc_add_modify (pre, tmp, dtype);
|
||||
|
||||
/* Point desc to the class _data field. */
|
||||
desc = class_data;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Fill in the array dtype. */
|
||||
tmp = gfc_conv_descriptor_dtype (desc);
|
||||
gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
|
||||
}
|
||||
|
||||
info->descriptor = desc;
|
||||
size = gfc_index_one_node;
|
||||
|
||||
/*
|
||||
Fill in the bounds and stride. This is a packed array, so:
|
||||
|
|
@ -3424,134 +3452,73 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
|
|||
static bool
|
||||
build_class_array_ref (gfc_se *se, tree base, tree index)
|
||||
{
|
||||
tree type;
|
||||
tree size;
|
||||
tree offset;
|
||||
tree decl = NULL_TREE;
|
||||
tree tmp;
|
||||
gfc_expr *expr = se->ss->info->expr;
|
||||
gfc_ref *ref;
|
||||
gfc_ref *class_ref = NULL;
|
||||
gfc_expr *class_expr;
|
||||
gfc_typespec *ts;
|
||||
gfc_symbol *sym;
|
||||
|
||||
if (se->expr && DECL_P (se->expr) && DECL_LANG_SPECIFIC (se->expr)
|
||||
&& GFC_DECL_SAVED_DESCRIPTOR (se->expr)
|
||||
&& GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr))))
|
||||
decl = se->expr;
|
||||
tmp = !VAR_P (base) ? gfc_get_class_from_expr (base) : NULL_TREE;
|
||||
|
||||
if (tmp != NULL_TREE)
|
||||
decl = tmp;
|
||||
else
|
||||
{
|
||||
if (expr == NULL
|
||||
/* The base expression does not contain a class component, either
|
||||
because it is a temporary array or array descriptor. Class
|
||||
array functions are correctly resolved above. */
|
||||
if (!expr
|
||||
|| (expr->ts.type != BT_CLASS
|
||||
&& !gfc_is_class_array_function (expr)
|
||||
&& !gfc_is_class_array_ref (expr, NULL)))
|
||||
return false;
|
||||
|
||||
if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS)
|
||||
ts = &expr->symtree->n.sym->ts;
|
||||
/* Obtain the expression for the class entity or component that is
|
||||
followed by an array reference, which is not an element, so that
|
||||
the span of the array can be obtained. */
|
||||
class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts);
|
||||
|
||||
if (!ts)
|
||||
return false;
|
||||
|
||||
sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL;
|
||||
if (sym && sym->attr.function
|
||||
&& sym == sym->result
|
||||
&& sym->backend_decl == current_function_decl)
|
||||
/* The temporary is the data field of the class data component
|
||||
of the current function. */
|
||||
decl = gfc_get_fake_result_decl (sym, 0);
|
||||
else if (sym)
|
||||
{
|
||||
if (decl == NULL_TREE)
|
||||
decl = expr->symtree->n.sym->backend_decl;
|
||||
/* For class arrays the tree containing the class is stored in
|
||||
GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
|
||||
For all others it's sym's backend_decl directly. */
|
||||
if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
|
||||
decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
|
||||
}
|
||||
else
|
||||
ts = NULL;
|
||||
decl = gfc_get_class_from_gfc_expr (class_expr);
|
||||
|
||||
for (ref = expr->ref; ref; ref = ref->next)
|
||||
{
|
||||
if (ref->type == REF_COMPONENT
|
||||
&& ref->u.c.component->ts.type == BT_CLASS
|
||||
&& ref->next && ref->next->type == REF_COMPONENT
|
||||
&& strcmp (ref->next->u.c.component->name, "_data") == 0
|
||||
&& ref->next->next
|
||||
&& ref->next->next->type == REF_ARRAY
|
||||
&& ref->next->next->u.ar.type != AR_ELEMENT)
|
||||
{
|
||||
ts = &ref->u.c.component->ts;
|
||||
class_ref = ref;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (POINTER_TYPE_P (TREE_TYPE (decl)))
|
||||
decl = build_fold_indirect_ref_loc (input_location, decl);
|
||||
|
||||
if (ts == NULL)
|
||||
if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
|
||||
return false;
|
||||
}
|
||||
|
||||
if (class_ref == NULL && expr && expr->symtree->n.sym->attr.function
|
||||
&& expr->symtree->n.sym == expr->symtree->n.sym->result
|
||||
&& expr->symtree->n.sym->backend_decl == current_function_decl)
|
||||
{
|
||||
decl = gfc_get_fake_result_decl (expr->symtree->n.sym, 0);
|
||||
}
|
||||
else if (expr && gfc_is_class_array_function (expr))
|
||||
{
|
||||
size = NULL_TREE;
|
||||
decl = NULL_TREE;
|
||||
for (tmp = base; tmp; tmp = TREE_OPERAND (tmp, 0))
|
||||
{
|
||||
tree type;
|
||||
type = TREE_TYPE (tmp);
|
||||
while (type)
|
||||
{
|
||||
if (GFC_CLASS_TYPE_P (type))
|
||||
decl = tmp;
|
||||
if (type != TYPE_CANONICAL (type))
|
||||
type = TYPE_CANONICAL (type);
|
||||
else
|
||||
type = NULL_TREE;
|
||||
}
|
||||
if (VAR_P (tmp))
|
||||
break;
|
||||
}
|
||||
|
||||
if (decl == NULL_TREE)
|
||||
return false;
|
||||
|
||||
se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
|
||||
}
|
||||
else if (class_ref == NULL)
|
||||
{
|
||||
if (decl == NULL_TREE)
|
||||
decl = expr->symtree->n.sym->backend_decl;
|
||||
/* For class arrays the tree containing the class is stored in
|
||||
GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
|
||||
For all others it's sym's backend_decl directly. */
|
||||
if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
|
||||
decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Remove everything after the last class reference, convert the
|
||||
expression and then recover its tailend once more. */
|
||||
gfc_se tmpse;
|
||||
ref = class_ref->next;
|
||||
class_ref->next = NULL;
|
||||
gfc_init_se (&tmpse, NULL);
|
||||
gfc_conv_expr (&tmpse, expr);
|
||||
gfc_add_block_to_block (&se->pre, &tmpse.pre);
|
||||
decl = tmpse.expr;
|
||||
class_ref->next = ref;
|
||||
}
|
||||
|
||||
if (POINTER_TYPE_P (TREE_TYPE (decl)))
|
||||
decl = build_fold_indirect_ref_loc (input_location, decl);
|
||||
|
||||
if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
|
||||
return false;
|
||||
se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
|
||||
|
||||
size = gfc_class_vtab_size_get (decl);
|
||||
|
||||
/* For unlimited polymorphic entities then _len component needs to be
|
||||
multiplied with the size. */
|
||||
size = gfc_resize_class_size_with_len (&se->pre, decl, size);
|
||||
|
||||
size = fold_convert (TREE_TYPE (index), size);
|
||||
|
||||
/* Build the address of the element. */
|
||||
type = TREE_TYPE (TREE_TYPE (base));
|
||||
offset = fold_build2_loc (input_location, MULT_EXPR,
|
||||
gfc_array_index_type,
|
||||
index, size);
|
||||
tmp = gfc_build_addr_expr (pvoid_type_node, base);
|
||||
tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
|
||||
tmp = fold_convert (build_pointer_type (type), tmp);
|
||||
|
||||
/* Return the element in the se expression. */
|
||||
se->expr = build_fold_indirect_ref_loc (input_location, tmp);
|
||||
se->expr = gfc_build_spanned_array_ref (base, index, size);
|
||||
return true;
|
||||
}
|
||||
|
||||
|
|
@ -10280,23 +10247,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
|
|||
}
|
||||
else if (expr1->ts.type == BT_CLASS)
|
||||
{
|
||||
tmp = expr1->rank ? gfc_get_class_from_expr (desc) : NULL_TREE;
|
||||
if (tmp == NULL_TREE)
|
||||
tmp = gfc_get_class_from_gfc_expr (expr1);
|
||||
|
||||
if (tmp != NULL_TREE)
|
||||
{
|
||||
tmp2 = gfc_class_vptr_get (tmp);
|
||||
cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
logical_type_node, tmp2,
|
||||
build_int_cst (TREE_TYPE (tmp2), 0));
|
||||
elemsize1 = gfc_class_vtab_size_get (tmp);
|
||||
elemsize1 = fold_build3_loc (input_location, COND_EXPR,
|
||||
gfc_array_index_type, cond,
|
||||
elemsize1, gfc_index_zero_node);
|
||||
}
|
||||
else
|
||||
elemsize1 = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&CLASS_DATA (expr1)->ts));
|
||||
/* Unfortunately, the lhs vptr is set too early in many cases.
|
||||
Play it safe by using the descriptor element length. */
|
||||
tmp = gfc_conv_descriptor_elem_len (desc);
|
||||
elemsize1 = fold_convert (gfc_array_index_type, tmp);
|
||||
}
|
||||
else
|
||||
elemsize1 = NULL_TREE;
|
||||
|
|
@ -10770,11 +10724,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
|
|||
|
||||
|
||||
/* We already set the dtype in the case of deferred character
|
||||
length arrays and unlimited polymorphic arrays. */
|
||||
length arrays and class lvalues. */
|
||||
if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
|
||||
&& ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
|
||||
|| coarray))
|
||||
&& !UNLIMITED_POLY (expr1))
|
||||
&& expr1->ts.type != BT_CLASS)
|
||||
{
|
||||
tmp = gfc_conv_descriptor_dtype (desc);
|
||||
gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
|
||||
|
|
|
|||
|
|
@ -380,15 +380,20 @@ gfc_vptr_size_get (tree vptr)
|
|||
#undef VTABLE_FINAL_FIELD
|
||||
|
||||
|
||||
/* Search for the last _class ref in the chain of references of this
|
||||
expression and cut the chain there. Albeit this routine is similiar
|
||||
to class.c::gfc_add_component_ref (), is there a significant
|
||||
difference: gfc_add_component_ref () concentrates on an array ref to
|
||||
be the last ref in the chain. This routine is oblivious to the kind
|
||||
of refs following. */
|
||||
/* IF ts is null (default), search for the last _class ref in the chain
|
||||
of references of the expression and cut the chain there. Although
|
||||
this routine is similiar to class.c:gfc_add_component_ref (), there
|
||||
is a significant difference: gfc_add_component_ref () concentrates
|
||||
on an array ref that is the last ref in the chain and is oblivious
|
||||
to the kind of refs following.
|
||||
ELSE IF ts is non-null the cut is at the class entity or component
|
||||
that is followed by an array reference, which is not an element.
|
||||
These calls come from trans-array.c:build_class_array_ref, which
|
||||
handles scalarized class array references.*/
|
||||
|
||||
gfc_expr *
|
||||
gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
|
||||
gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold,
|
||||
gfc_typespec **ts)
|
||||
{
|
||||
gfc_expr *base_expr;
|
||||
gfc_ref *ref, *class_ref, *tail = NULL, *array_ref;
|
||||
|
|
@ -396,27 +401,59 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
|
|||
/* Find the last class reference. */
|
||||
class_ref = NULL;
|
||||
array_ref = NULL;
|
||||
|
||||
if (ts)
|
||||
{
|
||||
if (e->symtree
|
||||
&& e->symtree->n.sym->ts.type == BT_CLASS)
|
||||
*ts = &e->symtree->n.sym->ts;
|
||||
else
|
||||
*ts = NULL;
|
||||
}
|
||||
|
||||
for (ref = e->ref; ref; ref = ref->next)
|
||||
{
|
||||
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
|
||||
array_ref = ref;
|
||||
|
||||
if (ref->type == REF_COMPONENT
|
||||
&& ref->u.c.component->ts.type == BT_CLASS)
|
||||
if (ts)
|
||||
{
|
||||
/* Component to the right of a part reference with nonzero rank
|
||||
must not have the ALLOCATABLE attribute. If attempts are
|
||||
made to reference such a component reference, an error results
|
||||
followed by an ICE. */
|
||||
if (array_ref && CLASS_DATA (ref->u.c.component)->attr.allocatable)
|
||||
return NULL;
|
||||
class_ref = ref;
|
||||
}
|
||||
if (ref->type == REF_COMPONENT
|
||||
&& ref->u.c.component->ts.type == BT_CLASS
|
||||
&& ref->next && ref->next->type == REF_COMPONENT
|
||||
&& !strcmp (ref->next->u.c.component->name, "_data")
|
||||
&& ref->next->next
|
||||
&& ref->next->next->type == REF_ARRAY
|
||||
&& ref->next->next->u.ar.type != AR_ELEMENT)
|
||||
{
|
||||
*ts = &ref->u.c.component->ts;
|
||||
class_ref = ref;
|
||||
break;
|
||||
}
|
||||
|
||||
if (ref->next == NULL)
|
||||
break;
|
||||
if (ref->next == NULL)
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
|
||||
array_ref = ref;
|
||||
|
||||
if (ref->type == REF_COMPONENT
|
||||
&& ref->u.c.component->ts.type == BT_CLASS)
|
||||
{
|
||||
/* Component to the right of a part reference with nonzero
|
||||
rank must not have the ALLOCATABLE attribute. If attempts
|
||||
are made to reference such a component reference, an error
|
||||
results followed by an ICE. */
|
||||
if (array_ref
|
||||
&& CLASS_DATA (ref->u.c.component)->attr.allocatable)
|
||||
return NULL;
|
||||
class_ref = ref;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (ts && *ts == NULL)
|
||||
return NULL;
|
||||
|
||||
/* Remove and store all subsequent references after the
|
||||
CLASS reference. */
|
||||
if (class_ref)
|
||||
|
|
@ -10005,17 +10042,20 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
|
|||
gfc_add_modify (&block, lse->expr, tmp);
|
||||
}
|
||||
/* If possible use the rhs vptr copy with trans_scalar_class_assign.... */
|
||||
else if (ts.type == BT_CLASS
|
||||
&& !trans_scalar_class_assign (&block, lse, rse))
|
||||
else if (ts.type == BT_CLASS)
|
||||
{
|
||||
gfc_add_block_to_block (&block, &lse->pre);
|
||||
gfc_add_block_to_block (&block, &rse->pre);
|
||||
/* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
|
||||
for the lhs which ensures that class data rhs cast as a string assigns
|
||||
correctly. */
|
||||
tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
|
||||
TREE_TYPE (rse->expr), lse->expr);
|
||||
gfc_add_modify (&block, tmp, rse->expr);
|
||||
|
||||
if (!trans_scalar_class_assign (&block, lse, rse))
|
||||
{
|
||||
/* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
|
||||
for the lhs which ensures that class data rhs cast as a string assigns
|
||||
correctly. */
|
||||
tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
|
||||
TREE_TYPE (rse->expr), lse->expr);
|
||||
gfc_add_modify (&block, tmp, rse->expr);
|
||||
}
|
||||
}
|
||||
else if (ts.type != BT_CLASS)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -422,6 +422,9 @@ get_array_span (tree type, tree decl)
|
|||
return NULL_TREE;
|
||||
}
|
||||
span = gfc_class_vtab_size_get (decl);
|
||||
/* For unlimited polymorphic entities then _len component needs
|
||||
to be multiplied with the size. */
|
||||
span = gfc_resize_class_size_with_len (NULL, decl, span);
|
||||
}
|
||||
else if (GFC_DECL_PTR_ARRAY_P (decl))
|
||||
{
|
||||
|
|
@ -439,13 +442,31 @@ get_array_span (tree type, tree decl)
|
|||
}
|
||||
|
||||
|
||||
tree
|
||||
gfc_build_spanned_array_ref (tree base, tree offset, tree span)
|
||||
{
|
||||
tree type;
|
||||
tree tmp;
|
||||
type = TREE_TYPE (TREE_TYPE (base));
|
||||
offset = fold_build2_loc (input_location, MULT_EXPR,
|
||||
gfc_array_index_type,
|
||||
offset, span);
|
||||
tmp = gfc_build_addr_expr (pvoid_type_node, base);
|
||||
tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
|
||||
tmp = fold_convert (build_pointer_type (type), tmp);
|
||||
if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE)
|
||||
|| !TYPE_STRING_FLAG (type))
|
||||
tmp = build_fold_indirect_ref_loc (input_location, tmp);
|
||||
return tmp;
|
||||
}
|
||||
|
||||
|
||||
/* Build an ARRAY_REF with its natural type. */
|
||||
|
||||
tree
|
||||
gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
|
||||
{
|
||||
tree type = TREE_TYPE (base);
|
||||
tree tmp;
|
||||
tree span = NULL_TREE;
|
||||
|
||||
if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
|
||||
|
|
@ -488,18 +509,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
|
|||
/* If a non-null span has been generated reference the element with
|
||||
pointer arithmetic. */
|
||||
if (span != NULL_TREE)
|
||||
{
|
||||
offset = fold_build2_loc (input_location, MULT_EXPR,
|
||||
gfc_array_index_type,
|
||||
offset, span);
|
||||
tmp = gfc_build_addr_expr (pvoid_type_node, base);
|
||||
tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
|
||||
tmp = fold_convert (build_pointer_type (type), tmp);
|
||||
if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE)
|
||||
|| !TYPE_STRING_FLAG (type))
|
||||
tmp = build_fold_indirect_ref_loc (input_location, tmp);
|
||||
return tmp;
|
||||
}
|
||||
return gfc_build_spanned_array_ref (base, offset, span);
|
||||
/* Otherwise use a straightforward array reference. */
|
||||
else
|
||||
return build4_loc (input_location, ARRAY_REF, type, base, offset,
|
||||
|
|
|
|||
|
|
@ -424,7 +424,8 @@ tree gfc_class_vptr_get (tree);
|
|||
tree gfc_class_len_get (tree);
|
||||
tree gfc_class_len_or_zero_get (tree);
|
||||
tree gfc_resize_class_size_with_len (stmtblock_t *, tree, tree);
|
||||
gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false);
|
||||
gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false,
|
||||
gfc_typespec **ts = NULL);
|
||||
/* Get an accessor to the class' vtab's * field, when a class handle is
|
||||
available. */
|
||||
tree gfc_class_vtab_hash_get (tree);
|
||||
|
|
@ -622,6 +623,9 @@ tree gfc_build_addr_expr (tree, tree);
|
|||
/* Build an ARRAY_REF. */
|
||||
tree gfc_build_array_ref (tree, tree, tree, tree vptr = NULL_TREE);
|
||||
|
||||
/* Build an array ref using pointer arithmetic. */
|
||||
tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
|
||||
|
||||
/* Creates a label. Decl is artificial if label_id == NULL_TREE. */
|
||||
tree gfc_build_label_decl (tree);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue