This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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.  */

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]