This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, fortran] Handle BT_CLASS as well as BT_DERIVED in trans-array.c
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Tue, 30 Nov 2010 18:13:02 +0100
- Subject: [patch, fortran] Handle BT_CLASS as well as BT_DERIVED in trans-array.c
Hello world,
the attached patch fixes a few instances where we only handled
BT_DERIVED without taking care of BT_CLASS too. Other files should
probably be audited for this, as well.
I am not aware of any test cases that this fixes, so none are attached.
Currently regression-testing. OK for trunk if it passes?
Thomas
2010-10-30 Thomas Koenig <tkoenig@gcc.gnu.org>
* trans-array.c (gfc_could_be_alias): Handle BT_CLASS
as well as BT_DERIVED.
(gfc_array_allocate): Likewise.
(gfc_conv_array_parameter): Likewise.
(structure_alloc_comps): Likewise.
(gfc_is_reallocatable_lhs): Likewise.
(gfc_trans_deferred_array): Likewise.
Index: trans-array.c
===================================================================
--- trans-array.c (Revision 167241)
+++ trans-array.c (Arbeitskopie)
@@ -3467,8 +3467,8 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
if (gfc_symbols_could_alias (lsym, rsym))
return 1;
- if (rsym->ts.type != BT_DERIVED
- && lsym->ts.type != BT_DERIVED)
+ if (rsym->ts.type != BT_DERIVED && rsym->ts.type != BT_CLASS
+ && lsym->ts.type != BT_DERIVED && lsym->ts.type != BT_CLASS)
return 0;
/* For derived types we must check all the component types. We can ignore
@@ -4232,7 +4232,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr,
gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
- if (expr->ts.type == BT_DERIVED
+ if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
&& expr->ts.u.derived->attr.alloc_comp)
{
tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr,
@@ -5779,7 +5779,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr *
if (sym->ts.type == BT_CHARACTER)
se->string_length = sym->ts.u.cl->backend_decl;
- if (sym->ts.type == BT_DERIVED)
+ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
{
gfc_conv_expr_descriptor (se, expr, ss);
se->expr = gfc_conv_array_data (se->expr);
@@ -5885,7 +5885,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr *
/* Deallocate the allocatable components of structures that are
not variable. */
- if (expr->ts.type == BT_DERIVED
+ if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
&& expr->ts.u.derived->attr.alloc_comp
&& expr->expr_type != EXPR_VARIABLE)
{
@@ -6302,7 +6302,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree
act on a chain of components. */
for (c = der_type->components; c; c = c->next)
{
- bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED)
+ bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED
+ || c->ts.type == BT_CLASS)
&& c->ts.u.derived->attr.alloc_comp;
cdecl = c->backend_decl;
ctype = TREE_TYPE (cdecl);
@@ -6565,7 +6566,8 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)
return true;
/* All that can be left are allocatable components. */
- if (expr->symtree->n.sym->ts.type != BT_DERIVED
+ if ((expr->symtree->n.sym->ts.type != BT_DERIVED
+ && expr->symtree->n.sym->ts.type != BT_CLASS)
|| !expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)
return false;
@@ -6948,7 +6950,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wr
int rank;
bool sym_has_alloc_comp;
- sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
+ sym_has_alloc_comp = (sym->ts.type == BT_DERIVED
+ || sym->ts.type == BT_CLASS)
&& sym->ts.u.derived->attr.alloc_comp;
/* Make sure the frontend gets these right. */