+2008-11-24 Paul Thomas <pault@gcc.gnu.org>
+
+ 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 <pault@gcc.gnu.org>
PR fortran/37735
gfc_conv_expr_descriptor (se, expr, ss);
}
-
/* Deallocate the allocatable components of structures that are
not variable. */
if (expr->ts.type == BT_DERIVED
}
-/* 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);
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
&& !(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
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);
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
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. */
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
{
stmtblock_t block;
stmtblock_t body;
bool l_is_temp;
+ bool scalar_to_array;
/* Assignment of the form lhs = rhs. */
gfc_start_block (&block);
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)
+2008-11-24 Paul Thomas <pault@gcc.gnu.org>
+
+ 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 <pault@gcc.gnu.org>
PR fortran/37735
--- /dev/null
+! { 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 <toon@moene.indiv.nluug.nl>
+!
+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" } }
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" } }
--- /dev/null
+! { 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 <burnus@gcc.gnu.org>
+!
+ 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
--- /dev/null
+! { 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 <tkoenig@gcc.gnu.org>
+!
+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
--- /dev/null
+! { 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 <tkoenig@gcc.gnu.org>
+!
+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
projects / thirdparty / gcc.git / commitdiff
