Commit 2be13164 by Tobias Burnus Committed by Tobias Burnus

re PR fortran/53643 ([OOP] ICE (segfault) with INTENT(OUT) CLASS array)

2012-06-13  Tobias Burnus  <burnus@net-b.de>

        PR fortran/53643
        * trans-decl.c (init_intent_out_dt): Fix for polymorphic arrays.
        * trans-array.c (structure_alloc_comps): Don't loop for
        scalar coarrays.

2012-06-13  Tobias Burnus  <burnus@net-b.de>

        PR fortran/53643
        * gfortran.dg/intent_out_7.f90: New.

From-SVN: r188507
parent d1f6dfe6
2012-06-13 Tobias Burnus <burnus@net-b.de> 2012-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/53643
* trans-decl.c (init_intent_out_dt): Fix for polymorphic arrays.
* trans-array.c (structure_alloc_comps): Don't loop for
scalar coarrays.
2012-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/53597 PR fortran/53597
* decl.c (match_attr_spec): Only mark module variables * decl.c (match_attr_spec): Only mark module variables
as SAVE_IMPLICIT for Fortran 2008 and later. as SAVE_IMPLICIT for Fortran 2008 and later.
......
...@@ -7318,9 +7318,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ...@@ -7318,9 +7318,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
if ((POINTER_TYPE_P (decl_type) && rank != 0) if ((POINTER_TYPE_P (decl_type) && rank != 0)
|| (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0)) || (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0))
decl = build_fold_indirect_ref_loc (input_location, decl);
decl = build_fold_indirect_ref_loc (input_location,
decl);
/* Just in case in gets dereferenced. */ /* Just in case in gets dereferenced. */
decl_type = TREE_TYPE (decl); decl_type = TREE_TYPE (decl);
...@@ -7328,7 +7326,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ...@@ -7328,7 +7326,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
/* If this an array of derived types with allocatable components /* If this an array of derived types with allocatable components
build a loop and recursively call this function. */ build a loop and recursively call this function. */
if (TREE_CODE (decl_type) == ARRAY_TYPE if (TREE_CODE (decl_type) == ARRAY_TYPE
|| GFC_DESCRIPTOR_TYPE_P (decl_type)) || (GFC_DESCRIPTOR_TYPE_P (decl_type) && rank != 0))
{ {
tmp = gfc_conv_array_data (decl); tmp = gfc_conv_array_data (decl);
var = build_fold_indirect_ref_loc (input_location, var = build_fold_indirect_ref_loc (input_location,
......
...@@ -3451,12 +3451,9 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) ...@@ -3451,12 +3451,9 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
&& !CLASS_DATA (f->sym)->attr.class_pointer && !CLASS_DATA (f->sym)->attr.class_pointer
&& CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp) && CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp)
{ {
tree decl = build_fold_indirect_ref_loc (input_location, tmp = gfc_class_data_get (f->sym->backend_decl);
f->sym->backend_decl); if (CLASS_DATA (f->sym)->as == NULL)
tmp = CLASS_DATA (f->sym)->backend_decl; tmp = build_fold_indirect_ref_loc (input_location, tmp);
tmp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (tmp), decl, tmp, NULL_TREE);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived, tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived,
tmp, tmp,
CLASS_DATA (f->sym)->as ? CLASS_DATA (f->sym)->as ?
......
2012-06-13 Tobias Burnus <burnus@net-b.de> 2012-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/53643
* gfortran.dg/intent_out_7.f90: New.
2012-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/53597 PR fortran/53597
* gfortran.dg/save_4.f90: New. * gfortran.dg/save_4.f90: New.
......
! { dg-do compile }
! { dg-options "-fcoarray=single" }
!
! PR fortran/53643
!
type t
integer, allocatable :: comp
end type t
contains
subroutine foo(x,y)
class(t), allocatable, intent(out) :: x(:)
class(t), intent(out) :: y(:)
end subroutine
subroutine foo2(x,y)
class(t), allocatable, intent(out) :: x
class(t), intent(out) :: y
end subroutine
subroutine bar(x,y)
class(t), intent(out) :: x(:)[*]
class(t), intent(out) :: y[*]
end subroutine
subroutine bar2(x,y)
type(t), intent(out) :: x(:)[*]
type(t), intent(out) :: y[*]
end subroutine
end
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