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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197844 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 154 insertions, 35 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e6ec4f4bd16..d3c8b58dd5a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,37 +1,45 @@
+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.
-        * arith.c: Replace gfc_try with bool type.
-        * array.c: Likewise.
-        * check.c: Likewise.
-        * class.c: Likewise.
-        * cpp.c: Likewise.
-        * cpp.h: Likewise.
-        * data.c: Likewise.
-        * data.h: Likewise.
-        * decl.c: Likewise.
-        * error.c: Likewise.
-        * expr.c: Likewise.
-        * f95-lang.c: Likewise.
-        * interface.c: Likewise.
-        * intrinsic.c: Likewise.
-        * intrinsic.h: Likewise.
-        * io.c: Likewise.
-        * match.c: Likewise.
-        * match.h: Likewise.
-        * module.c: Likewise.
-        * openmp.c: Likewise.
-        * parse.c: Likewise.
-        * parse.h: Likewise.
-        * primary.c: Likewise.
-        * resolve.c: Likewise.
-        * scanner.c: Likewise.
-        * simplify.c: Likewise.
-        * symbol.c: Likewise.
-        * trans-intrinsic.c: Likewise.
-        * trans-openmp.c: Likewise.
-        * trans-stmt.c: Likewise.
-        * trans-types.c: Likewise.
+	* gfortran.h: Remove enum gfc_try, replace gfc_try with bool type.
+	* arith.c: Replace gfc_try with bool type.
+	* array.c: Likewise.
+	* check.c: Likewise.
+	* class.c: Likewise.
+	* cpp.c: Likewise.
+	* cpp.h: Likewise.
+	* data.c: Likewise.
+	* data.h: Likewise.
+	* decl.c: Likewise.
+	* error.c: Likewise.
+	* expr.c: Likewise.
+	* f95-lang.c: Likewise.
+	* interface.c: Likewise.
+	* intrinsic.c: Likewise.
+	* intrinsic.h: Likewise.
+	* io.c: Likewise.
+	* match.c: Likewise.
+	* match.h: Likewise.
+	* module.c: Likewise.
+	* openmp.c: Likewise.
+	* parse.c: Likewise.
+	* parse.h: Likewise.
+	* primary.c: Likewise.
+	* resolve.c: Likewise.
+	* scanner.c: Likewise.
+	* simplify.c: Likewise.
+	* symbol.c: Likewise.
+	* trans-intrinsic.c: Likewise.
+	* trans-openmp.c: Likewise.
+	* trans-stmt.c: Likewise.
+	* trans-types.c: Likewise.
 
 2013-04-09  Tobias Burnus  <burnus@net-b.de>
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index fafde89f37b..779df164731 100644
--- a/gcc/fortran/trans-decl.c
+++ b/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;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 454755bddb7..de851a26c03 100644
--- a/gcc/fortran/trans-expr.c
+++ b/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;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 03adfddc543..ad6a1053a42 100644
--- a/gcc/fortran/trans.h
+++ b/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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ec11002256a..bbf27e6bb23 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_14.f90 b/gcc/testsuite/gfortran.dg/class_allocate_14.f90
new file mode 100644
index 00000000000..0c7aeb432d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_14.f90
@@ -0,0 +1,31 @@
+! { 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" } }
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
index 3aaff1e8c35..a41be79d91a 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
+++ b/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" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90
new file mode 100644
index 00000000000..bec7ee225fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90
@@ -0,0 +1,25 @@
+! { 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" } }