re PR fortran/47024 ([OOP] STORAGE_SIZE (for polymorphic types): Segfault at run...

2011-01-05  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-05  Janus Weil  <janus@gcc.gnu.org>

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

From-SVN: r168505

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 800fc3aea87676b440195b2c2b14420b3799de12..13cda0205c01811160f8658c8cffacc88b4c6176 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2011-01-05  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/46448

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b9c14169eec3482dde4e7e318d5dc324ba612633..829548c646e5fd3ef302dd978c283ef622fa9b3c 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3312,7 +3312,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
            {
              /* 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, gfc_wrapped_block * block)
              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);
            }
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fbe37bde615e78ca4cc0ec5b54d4ddd131afee1a..4a49afb0f3a539ccf46e7fe7d6940840aa38e155 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-05  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/47024
+       * gfortran.dg/storage_size_3.f08: New.
+
 2011-01-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/47154

diff --git a/gcc/testsuite/gfortran.dg/storage_size_3.f08 b/gcc/testsuite/gfortran.dg/storage_size_3.f08
new file mode 100644 (file)
index 0000000..71f5011
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/storage_size_3.f08
@@ -0,0 +1,12 @@
+! { dg-do run }
+!
+! PR 47024: [OOP] STORAGE_SIZE (for polymorphic types): Segfault at run time
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+type t
+  integer(kind=4) :: a
+end type
+class(t), allocatable :: y
+if (storage_size(y)/=32) call abort()
+end