This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC 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] PR 41586: Allocatable _scalars_ are never auto-deallocated


Hi all,

here is a patch for automatic deallocation of allocatable scalars.

There are four cases to take care of (which correspond to the
subroutines 'a' to 'd' in the test case):
1) plain allocatable scalar variables
2) allocatable scalar CLASS variables
3) allocatable scalar components
4) allocatable scalar CLASS components

All of them work fine now AFAICS.
One aside, however: There is a strange thing in the dump for case 'c'
(not necessarily connected to this patch):

  struct t1 m;

  m.j = 0B;
  {
    struct t1 D.1388;
    struct t1 t1.0;

    t1.0.pi = 3.1400001049041748046875e+0;
    t1.0.j = 0B;
    D.1388 = m;
    m = t1.0;
    if (D.1388.j != 0B)
      {
        __builtin_free ((void *) D.1388.j);
      }
    D.1388.j = 0B;
  }

If I'm not mistaken, this code was generated by "gfc_init_default_dt"
to handle the default initialization of the variable 'm'. But it's not
quite clear to me why we need two temporaries here, or why this
'D.1388' needs to be freed although it's barely used at all (and
certainly not allocated). Maybe someone can enlighten me on this
matter.


The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?


Cheers,
Janus


2009-10-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41586
	* parse.c (parse_derived): Correctly set 'alloc_comp' and 'pointer_comp'
	for CLASS variables.
	* trans-array.c (structure_alloc_comps): Handle deallocation and
	nullification of allocatable scalar components.
	* trans-decl.c (gfc_get_symbol_decl): Remember allocatable scalars for
	automatic deallocation.
	(gfc_trans_deferred_vars): Automatically deallocate allocatable scalars.


2009-10-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41586
	* gfortran.dg/auto_dealloc_1.f90: New test case.
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 152974)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -5906,6 +5906,36 @@ structure_alloc_comps (gfc_symbol * der_type, tree
 	      tmp = gfc_trans_dealloc_allocated (comp);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
+	  else if (c->attr.allocatable)
+	    {
+	      /* Allocatable scalar components.  */
+	      comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
+
+	      tmp = gfc_deallocate_with_status (comp, NULL_TREE, true, NULL);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+
+	      tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
+				 build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  else if (c->ts.type == BT_CLASS
+		   && c->ts.u.derived->components->attr.allocatable)
+	    {
+	      /* Allocatable scalar CLASS components.  */
+	      comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
+	      
+	      /* Add reference to '$data' component.  */
+	      tmp = c->ts.u.derived->components->backend_decl;
+	      comp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
+				  comp, tmp, NULL_TREE);
+
+	      tmp = gfc_deallocate_with_status (comp, NULL_TREE, true, NULL);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+
+	      tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
+				 build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
 	  break;
 
 	case NULLIFY_ALLOC_COMP:
@@ -5917,6 +5947,27 @@ structure_alloc_comps (gfc_symbol * der_type, tree
 				  decl, cdecl, NULL_TREE);
 	      gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node);
 	    }
+	  else if (c->attr.allocatable)
+	    {
+	      /* Allocatable scalar components.  */
+	      comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
+	      tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
+				 build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  else if (c->ts.type == BT_CLASS
+		   && c->ts.u.derived->components->attr.allocatable)
+	    {
+	      /* Allocatable scalar CLASS components.  */
+	      comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
+	      /* Add reference to '$data' component.  */
+	      tmp = c->ts.u.derived->components->backend_decl;
+	      comp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
+				  comp, tmp, NULL_TREE);
+	      tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
+				 build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
           else if (cmp_has_alloc_comps)
 	    {
 	      comp = fold_build3 (COMPONENT_REF, ctype,
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 152974)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -1187,15 +1187,18 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       /* Create variables to hold the non-constant bits of array info.  */
       gfc_build_qualified_array (decl, sym);
 
-      /* Remember this variable for allocation/cleanup.  */
-      gfc_defer_symbol_init (sym);
-
       if ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer)
 	GFC_DECL_PACKED_ARRAY (decl) = 1;
     }
 
-  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
+  /* Remember this variable for allocation/cleanup.  */
+  if (sym->attr.dimension || sym->attr.allocatable
+      || (sym->ts.type == BT_CLASS &&
+	  (sym->ts.u.derived->components->attr.dimension
+	   || sym->ts.u.derived->components->attr.allocatable)))
     gfc_defer_symbol_init (sym);
+  else if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
+    gfc_defer_symbol_init (sym);
   /* This applies a derived type default initializer.  */
   else if (sym->ts.type == BT_DERIVED
 	     && sym->attr.save == SAVE_NONE
@@ -3054,7 +3057,8 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree bo
     Allocation and initialization of array variables.
     Allocation of character string variables.
     Initialization and possibly repacking of dummy arrays.
-    Initialization of ASSIGN statement auxiliary variable.  */
+    Initialization of ASSIGN statement auxiliary variable.
+    Automatic deallocation.  */
 
 tree
 gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
@@ -3182,6 +3186,37 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tr
 	}
       else if (sym_has_alloc_comp)
 	fnbody = gfc_trans_deferred_array (sym, fnbody);
+      else if (sym->attr.allocatable
+	       || (sym->ts.type == BT_CLASS
+		   && sym->ts.u.derived->components->attr.allocatable))
+	{
+	  /* Automatic deallocatation of allocatable scalars.  */
+	  tree tmp;
+	  gfc_expr *e;
+	  gfc_se se;
+	  stmtblock_t block;
+	  
+	  e = gfc_lval_expr_from_sym (sym);
+	  if (sym->ts.type == BT_CLASS)
+	    gfc_add_component_ref (e, "$data");
+
+	  gfc_init_se (&se, NULL);
+	  se.want_pointer = 1;
+	  gfc_conv_expr (&se, e);
+	  gfc_free_expr (e);
+
+	  gfc_start_block (&block);
+	  gfc_add_expr_to_block (&block, fnbody);
+
+	  tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL);
+	  gfc_add_expr_to_block (&block, tmp);
+
+	  tmp = fold_build2 (MODIFY_EXPR, void_type_node,
+			     se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
+	  gfc_add_expr_to_block (&block, tmp);
+
+	  fnbody = gfc_finish_block (&block);
+	}
       else if (sym->ts.type == BT_CHARACTER)
 	{
 	  gfc_get_backend_locus (&loc);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(Revision 152974)
+++ gcc/fortran/parse.c	(Arbeitskopie)
@@ -2068,11 +2068,15 @@ endType:
     {
       /* Look for allocatable components.  */
       if (c->attr.allocatable
+	  || (c->ts.type == BT_CLASS
+	      && c->ts.u.derived->components->attr.allocatable)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
 	sym->attr.alloc_comp = 1;
 
       /* Look for pointer components.  */
       if (c->attr.pointer
+	  || (c->ts.type == BT_CLASS
+	      && c->ts.u.derived->components->attr.pointer)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
 	sym->attr.pointer_comp = 1;
 

Attachment: auto_dealloc_1.f90
Description: Binary data


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