Skip to content

R
riscv-gcc-1
Commit f118468a by Tobias Burnus
Options

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
parent bb506982
Showing with 154 additions and 35 deletions
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> 2013-04-11 Janne Blomqvist <jb@gcc.gnu.org>
* gfortran.h: Remove enum gfc_try, replace gfc_try with bool type. * gfortran.h: Remove enum gfc_try, replace gfc_try with bool type.
* arith.c: Replace gfc_try with bool type. * arith.c: Replace gfc_try with bool type.
* array.c: Likewise. * array.c: Likewise.
* check.c: Likewise. * check.c: Likewise.
* class.c: Likewise. * class.c: Likewise.
* cpp.c: Likewise. * cpp.c: Likewise.
* cpp.h: Likewise. * cpp.h: Likewise.
* data.c: Likewise. * data.c: Likewise.
* data.h: Likewise. * data.h: Likewise.
* decl.c: Likewise. * decl.c: Likewise.
* error.c: Likewise. * error.c: Likewise.
* expr.c: Likewise. * expr.c: Likewise.
* f95-lang.c: Likewise. * f95-lang.c: Likewise.
* interface.c: Likewise. * interface.c: Likewise.
* intrinsic.c: Likewise. * intrinsic.c: Likewise.
* intrinsic.h: Likewise. * intrinsic.h: Likewise.
* io.c: Likewise. * io.c: Likewise.
* match.c: Likewise. * match.c: Likewise.
* match.h: Likewise. * match.h: Likewise.
* module.c: Likewise. * module.c: Likewise.
* openmp.c: Likewise. * openmp.c: Likewise.
* parse.c: Likewise. * parse.c: Likewise.
* parse.h: Likewise. * parse.h: Likewise.
* primary.c: Likewise. * primary.c: Likewise.
* resolve.c: Likewise. * resolve.c: Likewise.
* scanner.c: Likewise. * scanner.c: Likewise.
* simplify.c: Likewise. * simplify.c: Likewise.
* symbol.c: Likewise. * symbol.c: Likewise.
* trans-intrinsic.c: Likewise. * trans-intrinsic.c: Likewise.
* trans-openmp.c: Likewise. * trans-openmp.c: Likewise.
* trans-stmt.c: Likewise. * trans-stmt.c: Likewise.
* trans-types.c: Likewise. * trans-types.c: Likewise.
2013-04-09 Tobias Burnus <burnus@net-b.de> 2013-04-09 Tobias Burnus <burnus@net-b.de>
......
gcc/fortran/trans-decl.c
...@@ -3649,7 +3649,36 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) ...@@ -3649,7 +3649,36 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
NULL_TREE); 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. */ /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT. */
array_type tmp = sym->as->type; 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) ...@@ -97,6 +97,24 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
tree 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) gfc_class_data_get (tree decl)
{ {
tree data; tree data;
......
gcc/fortran/trans.h
...@@ -341,6 +341,7 @@ gfc_wrapped_block; ...@@ -341,6 +341,7 @@ gfc_wrapped_block;
/* Class API functions. */ /* Class API functions. */
tree gfc_class_data_get (tree); tree gfc_class_data_get (tree);
tree gfc_class_vptr_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_hash_get (tree);
tree gfc_vtable_size_get (tree); tree gfc_vtable_size_get (tree);
tree gfc_vtable_extends_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> 2013-04-12 Marc Glisse <marc.glisse@inria.fr>
* gcc.dg/fold-cstvecshift.c: New testcase. * gcc.dg/fold-cstvecshift.c: New testcase.
......
gcc/testsuite/gfortran.dg/class_allocate_14.f90 0 → 100644
! { 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 @@ ...@@ -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_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 .&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, &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 .&yy._data.token, 0B, 0B, 0.;" 0 "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 .&xx._data.token, 0B, 0B, 0.;" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } } ! { dg-final { cleanup-tree-dump "original" } }
gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 0 → 100644
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment