Dear All,
This came up at
https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
gfortran produces wrong result from:
PROGRAM Main
INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
REAL :: array(5) = (/ (i+0.0, i = 1,5) /)
array = Fred(index,array)
PRINT *, array
CONTAINS
ELEMENTAL FUNCTION Fred (n, x)
REAL :: Fred
INTEGER, INTENT(IN) :: n
REAL, INTENT(IN) :: x
! In general, this would be in an external procedure
Fred = x+SUM(array(:n-1))+SUM(array(n+1:))
END FUNCTION Fred
END PROGRAM Main
outputs
15.0000000 29.0000000 56.0000000 109.000000
214.000000
when result should be
5*15.0
A temporary should be produced for array = Fred(index, array). See the
clf thread for the reasoning.
In a nutshell, the reason is:
The execution of the assignment shall have the same effect as
if the evaluation of expr and the evaluation of all expressions
in variable occurred before any portion of the variable is
defined by the assignment. The evaluation of expressions within
variable shall neither affect nor be affected by the evaluation
of expr.
Clearly, the above code violates this requirement because of the
references to 'array' in 'Fred'. I think that we will have to provide
an attribute that marks up array valued elemental functions that have
any external array references and provide a temporary for assignment
from one of these. Clearly something less brutal could be done, such
as attaching a list of external arrays (to the elemental function,
that is) to the symbol of the elemental function and comparing them
with the lhs of an assignment. However, this works and has no
perceivable effect on Polyhedron timings.
I will change the name of the flags to potentially_aliasing.
Bootstrapped and regtested on FC21/x86_64 - OK for trunk?
Paul
2015-02-08 Paul Thomas <[email protected]>
PR fortran/64952
* gfortran.h : Add 'potentially_aliased' field to symbol_attr.
* trans.h : Add 'potentially_aliased' field to gfc_ss_info.
* resolve.c (resolve_variable): Mark elemental function symbol
as 'potentially_aliased' if it has an array reference from
outside its own namespace.
* trans-array.c (gfc_conv_resolve_dependencies): If any ss is
marked as 'potentially_aliased' generate a temporary.
(gfc_walk_function_expr): If the function is marked as
'potentially_aliased', likewise mark the head gfc_ss.
2015-02-08 Paul Thomas <[email protected]>
PR fortran/64952
* gfortran.dg/finalize_28.f90: New test
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 220481)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_deallocate (gfc_code *code)
*** 5575,5585 ****
if (expr->rank || gfc_is_coarray (expr))
{
if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
&& !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
- gfc_ref *ref;
gfc_ref *last = NULL;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
last = ref;
--- 5575,5587 ----
if (expr->rank || gfc_is_coarray (expr))
{
+ gfc_ref *ref;
+
if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
&& !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
gfc_ref *last = NULL;
+
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
last = ref;
*************** gfc_trans_deallocate (gfc_code *code)
*** 5590,5602 ****
&& !(!last && expr->symtree->n.sym->attr.pointer))
{
tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
! expr->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}
}
! tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen,
! label_finish, expr);
! gfc_add_expr_to_block (&se.pre, tmp);
if (al->expr->ts.type == BT_CLASS)
gfc_reset_vptr (&se.pre, al->expr);
}
--- 5592,5636 ----
&& !(!last && expr->symtree->n.sym->attr.pointer))
{
tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
! expr->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}
}
!
! if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
! {
! tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen,
! label_finish, expr);
! gfc_add_expr_to_block (&se.pre, tmp);
! }
! else if (TREE_CODE (se.expr) == COMPONENT_REF
! && TREE_CODE (TREE_TYPE (se.expr)) == ARRAY_TYPE
! && TREE_CODE (TREE_TYPE (TREE_TYPE (se.expr)))
! == RECORD_TYPE)
! {
! /* class.c(finalize_component) generates these, when a
! finalizable entity has a non-allocatable derived type array
! component, which has allocatable components. Obtain the
! derived type of the array and deallocate the allocatable
! components. */
! for (ref = expr->ref; ref; ref = ref->next)
! {
! if (ref->u.c.component->attr.dimension
! && ref->u.c.component->ts.type == BT_DERIVED)
! break;
! }
!
! if (ref && ref->u.c.component->ts.u.derived->attr.alloc_comp
! && !gfc_is_finalizable (ref->u.c.component->ts.u.derived,
! NULL))
! {
! tmp = gfc_deallocate_alloc_comp
! (ref->u.c.component->ts.u.derived,
! se.expr, expr->rank);
! gfc_add_expr_to_block (&se.pre, tmp);
! }
! }
!
if (al->expr->ts.type == BT_CLASS)
gfc_reset_vptr (&se.pre, al->expr);
}
Index: gcc/testsuite/gfortran.dg/finalize_28.f90
===================================================================
*** gcc/testsuite/gfortran.dg/finalize_28.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/finalize_28.f90 (working copy)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ ! { dg-options "-fdump-tree-original" }
+ !
+ ! Test the fix for PR64932.
+ !
+ ! Reported by Daniel Shapiro <[email protected]>
+ !
+ module coo_graphs
+ implicit none
+ type :: dynamic_array
+ integer :: length, capacity, min_capacity
+ integer, allocatable :: array(:)
+ end type
+ type :: coo_graph
+ type(dynamic_array) :: edges(2)
+ integer, private :: ne
+ end type coo_graph
+ contains
+ subroutine coo_dump_edges(g, edges)
+ class(coo_graph), intent(in) :: g
+ integer, intent(out) :: edges(:,:)
+ end subroutine coo_dump_edges
+ end module coo_graphs
+ ! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
