From 8714fc766e4ee088b6853d11b09bebc386bdf333 Mon Sep 17 00:00:00 2001 From: pault Date: Mon, 24 Nov 2008 06:34:16 +0000 Subject: [PATCH] 2008-11-24 Paul Thomas PR fortran/34820 * trans-expr.c (gfc_conv_function_call): Remove all code to deallocate intent out derived types with allocatable components. (gfc_trans_assignment_1): An assignment from a scalar to an array of derived types with allocatable components, requires a deep copy to each array element and deallocation of the converted rhs expression afterwards. * trans-array.c : Minor whitespace. * trans-decl.c (init_intent_out_dt): Add code to deallocate allocatable components of derived types with intent out. (generate_local_decl): If these types are unused, set them referenced anyway but allow the uninitialized warning. PR fortran/34143 * trans-expr.c (gfc_trans_subcomponent_assign): If a conversion expression has a null data pointer argument, nullify the allocatable component. PR fortran/32795 * trans-expr.c (gfc_trans_subcomponent_assign): Only nullify the data pointer if the source is not a variable. 2008-11-24 Paul Thomas PR fortran/34820 * gfortran.dg/alloc_comp_constructor_6.f90 : New test. * gfortran.dg/alloc_comp_basics_1.f90 : Reduce expected refs to 'builtin_free' from 24 to 18. PR fortran/34143 * gfortran.dg/alloc_comp_constructor_5.f90 : New test. PR fortran/32795 * gfortran.dg/alloc_comp_constructor_4.f90 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@142148 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 25 +++++++ gcc/fortran/trans-array.c | 1 - gcc/fortran/trans-decl.c | 50 +++++++++++--- gcc/fortran/trans-expr.c | 79 +++++++++++++++------- gcc/testsuite/ChangeLog | 13 ++++ .../gfortran.dg/alloc_comp_auto_array_2.f90 | 40 +++++++++++ gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 | 2 +- .../gfortran.dg/alloc_comp_constructor_4.f90 | 16 +++++ .../gfortran.dg/alloc_comp_constructor_5.f90 | 29 ++++++++ .../gfortran.dg/alloc_comp_constructor_6.f90 | 38 +++++++++++ 10 files changed, 255 insertions(+), 38 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_auto_array_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_constructor_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_constructor_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_constructor_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4455365..5f55609 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,28 @@ +2008-11-24 Paul Thomas + + PR fortran/34820 + * trans-expr.c (gfc_conv_function_call): Remove all code to + deallocate intent out derived types with allocatable + components. + (gfc_trans_assignment_1): An assignment from a scalar to an + array of derived types with allocatable components, requires + a deep copy to each array element and deallocation of the + converted rhs expression afterwards. + * trans-array.c : Minor whitespace. + * trans-decl.c (init_intent_out_dt): Add code to deallocate + allocatable components of derived types with intent out. + (generate_local_decl): If these types are unused, set them + referenced anyway but allow the uninitialized warning. + + PR fortran/34143 + * trans-expr.c (gfc_trans_subcomponent_assign): If a conversion + expression has a null data pointer argument, nullify the + allocatable component. + + PR fortran/32795 + * trans-expr.c (gfc_trans_subcomponent_assign): Only nullify + the data pointer if the source is not a variable. + 2008-11-23 Paul Thomas PR fortran/37735 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 85e80c7..06d2e3d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5276,7 +5276,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, gfc_conv_expr_descriptor (se, expr, ss); } - /* Deallocate the allocatable components of structures that are not variable. */ if (expr->ts.type == BT_DERIVED diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 1b47f267..91db5df 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2781,20 +2781,34 @@ gfc_init_default_dt (gfc_symbol * sym, tree body) } -/* Initialize INTENT(OUT) derived type dummies. */ +/* Initialize INTENT(OUT) derived type dummies. As well as giving + them their default initializer, if they do not have allocatable + components, they have their allocatable components deallocated. */ + static tree init_intent_out_dt (gfc_symbol * proc_sym, tree body) { stmtblock_t fnblock; gfc_formal_arglist *f; + tree tmp; gfc_init_block (&fnblock); for (f = proc_sym->formal; f; f = f->next) if (f->sym && f->sym->attr.intent == INTENT_OUT - && f->sym->ts.type == BT_DERIVED - && !f->sym->ts.derived->attr.alloc_comp - && f->sym->value) - body = gfc_init_default_dt (f->sym, body); + && f->sym->ts.type == BT_DERIVED) + { + if (f->sym->ts.derived->attr.alloc_comp) + { + tmp = gfc_deallocate_alloc_comp (f->sym->ts.derived, + f->sym->backend_decl, + f->sym->as ? f->sym->as->rank : 0); + gfc_add_expr_to_block (&fnblock, tmp); + } + + if (!f->sym->ts.derived->attr.alloc_comp + && f->sym->value) + body = gfc_init_default_dt (f->sym, body); + } gfc_add_expr_to_block (&fnblock, body); return gfc_finish_block (&fnblock); @@ -3482,10 +3496,10 @@ generate_local_decl (gfc_symbol * sym) if (sym->attr.flavor == FL_VARIABLE) { if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master) - generate_dependency_declarations (sym); + generate_dependency_declarations (sym); if (sym->attr.referenced) - gfc_get_symbol_decl (sym); + gfc_get_symbol_decl (sym); /* INTENT(out) dummy arguments are likely meant to be set. */ else if (warn_unused_variable && sym->attr.dummy @@ -3502,20 +3516,34 @@ generate_local_decl (gfc_symbol * sym) && !(sym->attr.in_common || sym->attr.use_assoc || sym->mark)) gfc_warning ("Unused variable '%s' declared at %L", sym->name, &sym->declared_at); + /* For variable length CHARACTER parameters, the PARM_DECL already references the length variable, so force gfc_get_symbol_decl even when not referenced. If optimize > 0, it will be optimized away anyway. But do this only after emitting -Wunused-parameter warning if requested. */ - if (sym->attr.dummy && ! sym->attr.referenced - && sym->ts.type == BT_CHARACTER - && sym->ts.cl->backend_decl != NULL - && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) + if (sym->attr.dummy && !sym->attr.referenced + && sym->ts.type == BT_CHARACTER + && sym->ts.cl->backend_decl != NULL + && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) { sym->attr.referenced = 1; gfc_get_symbol_decl (sym); } + /* INTENT(out) dummy arguments with allocatable components are reset + by default and need to be set referenced to generate the code for + automatic lengths. */ + if (sym->attr.dummy && !sym->attr.referenced + && sym->ts.type == BT_DERIVED + && sym->ts.derived->attr.alloc_comp + && sym->attr.intent == INTENT_OUT) + { + sym->attr.referenced = 1; + gfc_get_symbol_decl (sym); + } + + /* Check for dependencies in the array specification and string length, adding the necessary declarations to the function. We mark the symbol now, as well as in traverse_ns, to prevent diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e096021..5d3894c 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2742,14 +2742,11 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, gfc_add_block_to_block (&post, &parmse.post); /* Allocated allocatable components of derived types must be - deallocated for INTENT(OUT) dummy arguments and non-variable - scalars. Non-variable arrays are dealt with in trans-array.c - (gfc_conv_array_parameter). */ + deallocated for non-variable scalars. Non-variable arrays are + dealt with in trans-array.c(gfc_conv_array_parameter). */ if (e && e->ts.type == BT_DERIVED && e->ts.derived->attr.alloc_comp - && ((formal && formal->sym->attr.intent == INTENT_OUT) - || - (e->expr_type != EXPR_VARIABLE && !e->rank))) + && (e->expr_type != EXPR_VARIABLE && !e->rank)) { int parm_rank; tmp = build_fold_indirect_ref (parmse.expr); @@ -2764,24 +2761,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, case (SCALAR_POINTER): tmp = build_fold_indirect_ref (tmp); break; - case (ARRAY): - tmp = parmse.expr; - break; } - tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank); - if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional) - tmp = build3_v (COND_EXPR, gfc_conv_expr_present (e->symtree->n.sym), - tmp, build_empty_stmt ()); - - if (e->expr_type != EXPR_VARIABLE) - /* Don't deallocate non-variables until they have been used. */ - gfc_add_expr_to_block (&se->post, tmp); - else - { - gcc_assert (formal && formal->sym->attr.intent == INTENT_OUT); - gfc_add_expr_to_block (&se->pre, tmp); - } + tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank); + gfc_add_expr_to_block (&se->post, tmp); } /* Character strings are passed as two parameters, a length and a @@ -3610,9 +3593,10 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) cm->as->rank); gfc_add_expr_to_block (&block, tmp); - gfc_add_block_to_block (&block, &se.post); - gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node); + + if (expr->expr_type != EXPR_VARIABLE) + gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node); /* Shift the lbound and ubound of temporaries to being unity, rather than zero, based. Calculate the offset for all cases. */ @@ -3644,6 +3628,35 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2); gfc_add_modify (&block, offset, tmp); } + + if (expr->expr_type == EXPR_FUNCTION + && expr->value.function.isym + && expr->value.function.isym->conversion + && expr->value.function.actual->expr + && expr->value.function.actual->expr->expr_type + == EXPR_VARIABLE) + { + /* If a conversion expression has a null data pointer + argument, nullify the allocatable component. */ + gfc_symbol *s; + tree non_null_expr; + tree null_expr; + s = expr->value.function.actual->expr->symtree->n.sym; + if (s->attr.allocatable || s->attr.pointer) + { + non_null_expr = gfc_finish_block (&block); + gfc_start_block (&block); + gfc_conv_descriptor_data_set (&block, dest, + null_pointer_node); + null_expr = gfc_finish_block (&block); + tmp = gfc_conv_descriptor_data_get (s->backend_decl); + tmp = build2 (EQ_EXPR, boolean_type_node, tmp, + fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + return build3_v (COND_EXPR, tmp, null_expr, + non_null_expr); + } + } } else { @@ -4533,6 +4546,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) stmtblock_t block; stmtblock_t body; bool l_is_temp; + bool scalar_to_array; /* Assignment of the form lhs = rhs. */ gfc_start_block (&block); @@ -4616,9 +4630,24 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) else gfc_conv_expr (&lse, expr1); + /* Assignments of scalar derived types with allocatable components + to arrays must be done with a deep copy and the rhs temporary + must have its components deallocated afterwards. */ + scalar_to_array = (expr2->ts.type == BT_DERIVED + && expr2->ts.derived->attr.alloc_comp + && expr2->expr_type != EXPR_VARIABLE + && !gfc_is_constant_expr (expr2) + && expr1->rank && !expr2->rank); + if (scalar_to_array) + { + tmp = gfc_deallocate_alloc_comp (expr2->ts.derived, rse.expr, 0); + gfc_add_expr_to_block (&loop.post, tmp); + } + tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, l_is_temp || init_flag, - expr2->expr_type == EXPR_VARIABLE); + (expr2->expr_type == EXPR_VARIABLE) + || scalar_to_array); gfc_add_expr_to_block (&body, tmp); if (lss == gfc_ss_terminator) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 17ed9f1..1ccc573 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2008-11-24 Paul Thomas + + PR fortran/34820 + * gfortran.dg/alloc_comp_constructor_6.f90 : New test. + * gfortran.dg/alloc_comp_basics_1.f90 : Reduce expected refs to + 'builtin_free' from 24 to 18. + + PR fortran/34143 + * gfortran.dg/alloc_comp_constructor_5.f90 : New test. + + PR fortran/32795 + * gfortran.dg/alloc_comp_constructor_4.f90 : New test. + 2008-11-23 Paul Thomas PR fortran/37735 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_2.f90 new file mode 100644 index 0000000..c4c4ae2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_2.f90 @@ -0,0 +1,40 @@ +! { dg-do run } +! Tests the fix for PR34820, in which the nullification of the +! automatic array iregion occurred in the caller, rather than the +! callee. Since 'nproc' was not available, an ICE ensued. During +! the bug fix, it was found that the scalar to array assignment +! of derived types with allocatable components did not work and +! the fix of this is tested too. +! +! Contributed by Toon Moene +! +module grid_io + type grid_index_region + integer, allocatable::lons(:) + end type grid_index_region +contains + subroutine read_grid_header() + integer :: npiece = 1 + type(grid_index_region),allocatable :: iregion(:) + allocate (iregion(npiece + 1)) + call read_iregion(npiece,iregion) + if (size(iregion) .ne. npiece + 1) call abort + if (.not.allocated (iregion(npiece)%lons)) call abort + if (allocated (iregion(npiece+1)%lons)) call abort + if (any (iregion(npiece)%lons .ne. [(i, i = 1, npiece)])) call abort + deallocate (iregion) + end subroutine read_grid_header + + subroutine read_iregion (nproc,iregion) + integer,intent(in)::nproc + type(grid_index_region), intent(OUT)::iregion(1:nproc) + integer :: iarg(nproc) + iarg = [(i, i = 1, nproc)] + iregion = grid_index_region (iarg) ! + end subroutine read_iregion +end module grid_io + + use grid_io + call read_grid_header +end +! { dg-final { cleanup-tree-dump "grid_io" } } diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 index 11f655e..e024d8b 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 @@ -139,6 +139,6 @@ contains end subroutine check_alloc2 end program alloc -! { dg-final { scan-tree-dump-times "builtin_free" 27 "original" } } +! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } } ! { dg-final { cleanup-tree-dump "original" } } ! { dg-final { cleanup-modules "alloc_m" } } diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_4.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_4.f90 new file mode 100644 index 0000000..4b047da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_4.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! Tests the fix for PR32795, which was primarily about memory leakage is +! certain combinations of alloctable components and constructors. This test +! which appears in comment #2 of the PR has the advantage of a wrong +! numeric result which is symptomatic. +! +! Contributed by Tobias Burnus +! + type :: a + integer, allocatable :: i(:) + end type a + type(a) :: x, y + x = a ([1, 2, 3]) + y = a (x%i(:)) ! used to cause a memory leak and wrong result + if (any (x%i .ne. [1, 2, 3])) call abort +end diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_5.f90 new file mode 100644 index 0000000..9526112 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_5.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! { dg-options "-fdefault-integer-8" } +! Tests the fix for PR34143, in which the implicit conversion of yy, with +! fdefault-integer-8, would cause a segfault at runtime. +! +! Contributed by Thomas Koenig +! +Program test_constructor + implicit none + type :: thytype + integer(4) :: a(2,2) + end type thytype + type :: mytype + integer(4), allocatable :: a(:, :) + type(thytype), allocatable :: q(:) + end type mytype + integer, allocatable :: yy(:,:) + type (thytype), allocatable :: bar(:) + type (mytype) :: x, y + x = mytype(yy, bar) + if (allocated (x%a) .or. allocated (x%q)) call abort + allocate (yy(2,2)) + allocate (bar(2)) + yy = reshape ([10,20,30,40],[2,2]) + bar = thytype (reshape ([1,2,3,4],[2,2])) + ! Check that unallocated allocatables work + y = mytype(yy, bar) + if (.not.allocated (y%a) .or. .not.allocated (y%q)) call abort +end program test_constructor diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_6.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_6.f90 new file mode 100644 index 0000000..b2ac4f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_6.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-options "-fdefault-integer-8 -O2" } +! Tests the fix for PR34143, where the implicit type +! conversion in the derived type constructor would fail, +! when 'yy' was not allocated. The testscase is an +! extract from alloc_comp_constructor.f90. +! +! Reported by Thomas Koenig +! +Program test_constructor + implicit none + type :: thytype + integer(4) :: a(2,2) + end type thytype + type :: mytype + integer(4), allocatable :: a(:, :) + type(thytype), allocatable :: q(:) + end type mytype + integer, allocatable :: yy(:,:) + type (thytype), allocatable :: bar(:) + call non_alloc + call alloc +contains + subroutine non_alloc + type (mytype) :: x + x = mytype(yy, bar) + if (allocated (x%a) .or. allocated (x%q)) call abort + end subroutine non_alloc + subroutine alloc + type (mytype) :: x + allocate (yy(2,2)) + allocate (bar(2)) + yy = reshape ([10,20,30,40],[2,2]) + bar = thytype (reshape ([1,2,3,4],[2,2])) + x = mytype(yy, bar) + if (.not.allocated (x%a) .or. .not.allocated (x%q)) call abort + end subroutine alloc +end program test_constructor -- 2.7.4