From 2be13164c11f39884bc26e941e5c573eacfbe0ac Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 13 Jun 2012 13:57:45 +0200 Subject: [PATCH] re PR fortran/53643 ([OOP] ICE (segfault) with INTENT(OUT) CLASS array) 2012-06-13 Tobias Burnus 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 PR fortran/53643 * gfortran.dg/intent_out_7.f90: New. From-SVN: r188507 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/trans-array.c | 6 ++--- gcc/fortran/trans-decl.c | 9 +++----- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/intent_out_7.f90 | 26 ++++++++++++++++++++++ 5 files changed, 43 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_out_7.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ffe1254a193..27c06795313 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2012-06-13 Tobias Burnus + + 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 PR fortran/53597 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 253446215d3..0e782101a54 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7318,9 +7318,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, if ((POINTER_TYPE_P (decl_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. */ decl_type = TREE_TYPE (decl); @@ -7328,7 +7326,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, /* If this an array of derived types with allocatable components build a loop and recursively call this function. */ 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); var = build_fold_indirect_ref_loc (input_location, diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 637376b7412..75a21604cff 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -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)->ts.u.derived->attr.alloc_comp) { - tree decl = build_fold_indirect_ref_loc (input_location, - f->sym->backend_decl); - tmp = CLASS_DATA (f->sym)->backend_decl; - 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_class_data_get (f->sym->backend_decl); + if (CLASS_DATA (f->sym)->as == NULL) + tmp = build_fold_indirect_ref_loc (input_location, tmp); tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived, tmp, CLASS_DATA (f->sym)->as ? diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3649dcfd8b5..a8384ffc4ab 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-06-13 Tobias Burnus + + PR fortran/53643 + * gfortran.dg/intent_out_7.f90: New. + 2012-06-13 Tobias Burnus PR fortran/53597 diff --git a/gcc/testsuite/gfortran.dg/intent_out_7.f90 b/gcc/testsuite/gfortran.dg/intent_out_7.f90 new file mode 100644 index 00000000000..d75fff803da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intent_out_7.f90 @@ -0,0 +1,26 @@ +! { 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 -- 2.30.2