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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e6ec4f4..d3c8b58 100644 (file)
--- 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 fafde89..779df16 100644 (file)
--- 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 454755b..de851a2 100644 (file)
--- 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 03adfdd..ad6a105 100644 (file)
--- 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 ec11002..bbf27e6 100644 (file)
--- 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 (file)
index 0000000..0c7aeb4
--- /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 3aaff1e..a41be79 100644 (file)
--- 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 (file)
index 0000000..bec7ee2
--- /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" } }