re PR fortran/56845 ([OOP] _vptr not set to declared type for CLASS + SAVE)

2013-04-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56845
        * trans-decl.c (gfc_trans_deferred_vars): Set _vptr for
        allocatable static BT_CLASS.
        * trans-expr.c (gfc_class_set_static_fields): New function.
        * trans.h (gfc_class_set_static_fields): New prototype.

2013-04-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56845
        * gfortran.dg/class_allocate_14.f90: New.
        * gfortran.dg/coarray_lib_alloc_2.f90: Update
        * scan-tree-dump-times.
        * gfortran.dg/coarray_lib_alloc_3.f90: New.

From-SVN: r197844

gcc/fortran/ChangeLog

+2013-04-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56845
+	* trans-decl.c (gfc_trans_deferred_vars): Set _vptr for
+	allocatable static BT_CLASS.
+	* trans-expr.c (gfc_class_set_static_fields): New function.
+	* trans.h (gfc_class_set_static_fields): New prototype.
+
 2013-04-11  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	* gfortran.h: Remove enum gfc_try, replace gfc_try with bool type.

gcc/fortran/trans-decl.c

@@ -3649,7 +3649,36 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 				NULL_TREE);
 	}
 
-      if (sym->attr.dimension || sym->attr.codimension)
+      if (sym->ts.type == BT_CLASS && TREE_STATIC (sym->backend_decl)
+	  && CLASS_DATA (sym)->attr.allocatable)
+	{
+	  tree vptr;
+
+          if (UNLIMITED_POLY (sym))
+	    vptr = null_pointer_node;
+	  else
+	    {
+	      gfc_symbol *vsym;
+	      vsym = gfc_find_derived_vtab (sym->ts.u.derived);
+	      vptr = gfc_get_symbol_decl (vsym);
+	      vptr = gfc_build_addr_expr (NULL, vptr);
+	    }
+
+	  if (CLASS_DATA (sym)->attr.dimension
+	      || (CLASS_DATA (sym)->attr.codimension
+		  && gfc_option.coarray != GFC_FCOARRAY_LIB))
+	    {
+	      tmp = gfc_class_data_get (sym->backend_decl);
+	      tmp = gfc_build_null_descriptor (TREE_TYPE (tmp));
+	    }
+	  else
+	    tmp = null_pointer_node;
+
+	  DECL_INITIAL (sym->backend_decl)
+		= gfc_class_set_static_fields (sym->backend_decl, vptr, tmp);
+	  TREE_CONSTANT (DECL_INITIAL (sym->backend_decl)) = 1;
+	}
+      else if (sym->attr.dimension || sym->attr.codimension)
 	{
           /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT.  */
           array_type tmp = sym->as->type;

gcc/fortran/trans-expr.c

@@ -97,6 +97,24 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 
 
 tree
+gfc_class_set_static_fields (tree decl, tree vptr, tree data)
+{
+  tree tmp;
+  tree field;
+  vec<constructor_elt, va_gc> *init = NULL;
+
+  field = TYPE_FIELDS (TREE_TYPE (decl));
+  tmp = gfc_advance_chain (field, CLASS_DATA_FIELD);
+  CONSTRUCTOR_APPEND_ELT (init, tmp, data);
+
+  tmp = gfc_advance_chain (field, CLASS_VPTR_FIELD);
+  CONSTRUCTOR_APPEND_ELT (init, tmp, vptr);
+
+  return build_constructor (TREE_TYPE (decl), init);
+}
+
+
+tree
 gfc_class_data_get (tree decl)
 {
   tree data;

gcc/fortran/trans.h

@@ -341,6 +341,7 @@ gfc_wrapped_block;
 /* Class API functions.  */
 tree gfc_class_data_get (tree);
 tree gfc_class_vptr_get (tree);
+tree gfc_class_set_static_fields (tree, tree, tree);
 tree gfc_vtable_hash_get (tree);
 tree gfc_vtable_size_get (tree);
 tree gfc_vtable_extends_get (tree);

gcc/testsuite/ChangeLog

+2013-04-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56845
+	* gfortran.dg/class_allocate_14.f90: New.
+	* gfortran.dg/coarray_lib_alloc_2.f90: Update scan-tree-dump-times.
+	* gfortran.dg/coarray_lib_alloc_3.f90: New.
+
 2013-04-12  Marc Glisse  <marc.glisse@inria.fr>
 
 	* gcc.dg/fold-cstvecshift.c: New testcase.

gcc/testsuite/gfortran.dg/class_allocate_14.f90

+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/56845
+!
+module m
+type t
+integer ::a
+end type t
+contains
+subroutine sub
+  type(t), save, allocatable :: x
+  class(t), save,allocatable :: y
+  if (.not. same_type_as(x,y)) call abort()
+end subroutine sub
+subroutine sub2
+  type(t), save, allocatable :: a(:)
+  class(t), save,allocatable :: b(:)
+  if (.not. same_type_as(a,b)) call abort()
+end subroutine sub2
+end module m
+
+use m
+call sub()
+call sub2()
+end
+
+! { dg-final { scan-tree-dump-times "static struct __class_m_T_1_0a b = {._data={.data=0B}, ._vptr=&__vtab_m_T};" 1 "original" } }
+! { dg-final { scan-tree-dump-times "static struct __class_m_T_a y = {._data=0B, ._vptr=&__vtab_m_T};" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+

gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90

@@ -18,6 +18,6 @@
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 0 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 0 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }

gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90

+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Allocate/deallocate with libcaf.
+!
+! As coarray_lib_alloc_2.f90 but for a subroutine instead of the PROGRAM
+!
+subroutine test
+ type t
+ end type t
+ class(t), allocatable :: xx[:], yy(:)[:]
+ integer :: stat
+ character(len=200) :: errmsg
+ allocate(xx[*], stat=stat, errmsg=errmsg)
+ allocate(yy(2)[*], stat=stat, errmsg=errmsg)
+ deallocate(xx,yy,stat=stat, errmsg=errmsg)
+ end
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }