[Patch, Fortran, OOP] PR 467024: STORAGE_SIZE (for polymorphic types): Segfault at run time

[Janus Weil <janus at gcc dot gnu dot org>]

Hi all,

here's the fix for a wrong-code OOP problem: Calling the intrinsic
STORAGE_SIZE on an unallocated polymorphic allocatable would produce a
segfault. The reason for this is that the implementation of
STORAGE_SIZE queries the _size field of the vtab which corresponds the
the variable's dynamic type (being pointed to by the _vptr component
of the class container), where the _vptr was not being initialized.

The F08 standard states in section 4.3.1.3 that the dynamic type of an
unallocated allocatable is given by its declared type. What the patch
does is to add an initialization statement for the _vptr component
(according to the declared type). Up to now we only initialized the
_data component of polymorphic allocatables.

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

Cheers,
Janus


2011-01-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47024
	* trans-decl.c (gfc_trans_deferred_vars): Initialize the _vpr component
	of polymorphic allocatables according to their declared type.


2011-01-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47024
	* gfortran.dg/storage_size_3.f08: New.

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 168479)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -3312,7 +3312,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gf
 	    {
 	      /* Nullify and automatic deallocation of allocatable
 		 scalars.  */
-	      tree tmp;
+	      tree tmp = NULL;
 	      gfc_expr *e;
 	      gfc_se se;
 	      stmtblock_t init;
@@ -3337,8 +3337,23 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gf
 	      if (!sym->attr.result)
 		tmp = gfc_deallocate_scalar_with_status (se.expr, NULL, true,
 							 NULL, sym->ts);
-	      else
-		tmp = NULL;
+
+	      if (sym->ts.type == BT_CLASS)
+		{
+		  /* Initialize _vptr to declared type.  */
+		  gfc_symbol *vtab = gfc_find_derived_vtab (sym->ts.u.derived);
+		  tree rhs;
+		  e = gfc_lval_expr_from_sym (sym);
+		  gfc_add_vptr_component (e);
+		  gfc_init_se (&se, NULL);
+		  se.want_pointer = 1;
+		  gfc_conv_expr (&se, e);
+		  gfc_free_expr (e);
+		  rhs = gfc_build_addr_expr (TREE_TYPE (se.expr),
+					     gfc_get_symbol_decl (vtab));
+		  gfc_add_modify (&init, se.expr, rhs);
+		}
+
 	      gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
 	    }
 	}

Attachment: storage_size_3.f08
Description: Binary data