Dear Mikael, dear all,
Thank you for the previous review. I believe that the attached
responds to all of your comments and correctly compiles the three
testcases that you provided. Two of these have been included in the
original testcase and the third appears separately.
Bootstrapped and reg
tested on FC21/x86_64 - OK for trunk?
Cheers
Paul
2015-02-10 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/64952
* gfortran.h : Add 'array_outer_dependency' to symbol_attr.
* trans.h : Add 'array_outer_dependency' to gfc_ss_info.
* module.c : Add AB_ARRAY_OUTER_DEPENDENCY to ab_attribute.
Add same to attr_bits.
(mio_symbol_attribute): Handle 'array_outer_dependency' attr
in module read and write.
* resolve.c (resolve_function): If an elemental function is
referenced that is marked as having an external array reference
and the current namespace is that of an elemental function,
mark the containing function likewise.
(resolve_variable): Mark elemental function symbol
as 'array_outer_dependency' if it has an array reference from
outside its own namespace.
* trans-array.c (gfc_conv_resolve_dependencies): If any ss is
marked as 'array_outer_dependency' generate a temporary.
(gfc_walk_function_expr): If the function is marked as
'array_outer_dependency', likewise mark the head gfc_ss.
2015-02-10 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/64952
* gfortran.dg/elemental_dependency_4.f90: New test
* gfortran.dg/elemental_dependency_5.f90: New test
On 8 February 2015 at 19:16, Paul Richard Thomas
<paul.richard.tho...@gmail.com> wrote:
> Dear Mikael,
>
> Thank you very much for the review. You raise some points that I had
> thought about and others that I hadn't. I also realised that such
> things as blocks, within the elemental function would through the fix
> as well. I'll defer doing anything with it until tomorrow night.
>
> I reason that there is always going to be an 'ss', although I should
> check that it is not gfc_ss_terminator, and that it does not matter
> which one is flagged. I should add a comment to that effect; it's not
> quite as hackish as it looks, methinks.
>
> I will be back!
>
> Paul
>
> On 8 February 2015 at 18:27, Mikael Morin <mikael.mo...@sfr.fr> wrote:
>> Hello Paul,
>>
>> comments below
>>
>> Le 08/02/2015 16:24, Paul Richard Thomas a écrit :
>>>
>>> Index: gcc/fortran/gfortran.h
>>> ===================================================================
>>> *** gcc/fortran/gfortran.h (revision 220482)
>>> --- gcc/fortran/gfortran.h (working copy)
>>> *************** typedef struct
>>> *** 789,794 ****
>>> --- 789,798 ----
>>> cannot alias. Note that this is zero for PURE procedures. */
>>> unsigned implicit_pure:1;
>>>
>>> + /* This set for an elemental function that contains expressions for
>>> + arrays coming from outside its namespace. */
>>> + unsigned potentially_aliased:1;
>>> +
>> aliased is more something about pointers, so how about naming it
>> something like array_outer_dependency? Anyway, that's minor.
>>
>> I wonder whether we should negate the meaning, that is set the flag if
>> there is no external dependency.
>> If we can get the conditions to set it exhaustively right, both are
>> equivalent. Otherwise... maybe not.
>>
>>> /* This is set if the subroutine doesn't return. Currently, this
>>> is only possible for intrinsic subroutines. */
>>> unsigned noreturn:1;
>>> Index: gcc/fortran/trans.h
>>> ===================================================================
>>> *** gcc/fortran/trans.h (revision 220481)
>>> --- gcc/fortran/trans.h (working copy)
>>> *************** typedef struct gfc_ss_info
>>> *** 226,231 ****
>>> --- 226,235 ----
>>> /* Suppresses precalculation of scalars in WHERE assignments. */
>>> unsigned where:1;
>>>
>>> + /* Signals that an array argument of an elemental function might be
>>> aliased,
>>> + thereby generating a temporary in assignments. */
>>> + unsigned potentially_aliased:1;
>>> +
>>> /* Tells whether the SS is for an actual argument which can be a NULL
>>> reference. In other words, the associated dummy argument is
>>> OPTIONAL.
>>> Used to handle elemental procedures. */
>>> Index: gcc/fortran/resolve.c
>>> ===================================================================
>>> *** gcc/fortran/resolve.c (revision 220481)
>>> --- gcc/fortran/resolve.c (working copy)
>>> *************** resolve_variable (gfc_expr *e)
>>> *** 5054,5059 ****
>>> --- 5054,5067 ----
>>> && gfc_current_ns->parent->parent == sym->ns)))
>>> sym->attr.host_assoc = 1;
>>>
>>> + if (sym->attr.dimension
>>> + && (sym->ns != gfc_current_ns
>>> + || sym->attr.use_assoc
>>> + || sym->attr.in_common)
>>> + && gfc_elemental (NULL)
>>> + && gfc_current_ns->proc_name->attr.function)
>>> + gfc_current_ns->proc_name->attr.potentially_aliased = 1;
>> I would expect the flag to also be copied between procedures in some
>> cases; namely if A calls B, and B has the flag, then A has the flag.
>> There is also the case of external procedures (for which the flag is not
>> known -> assume the worst)
>>
>>> +
>>> resolve_procedure:
>>> if (t && !resolve_procedure_expression (e))
>>> t = false;
>>> Index: gcc/fortran/trans-array.c
>>> ===================================================================
>>> *** gcc/fortran/trans-array.c (revision 220482)
>>> --- gcc/fortran/trans-array.c (working copy)
>>> *************** gfc_conv_resolve_dependencies (gfc_loopi
>>> *** 4391,4396 ****
>>> --- 4391,4402 ----
>>> {
>>> ss_expr = ss->info->expr;
>>>
>>> + if (ss->info->potentially_aliased)
>>> + {
>>> + nDepend = 1;
>>> + break;
>>> + }
>>> +
>>> if (ss->info->type != GFC_SS_SECTION)
>>> {
>>> if (flag_realloc_lhs
>>> *************** gfc_walk_function_expr (gfc_ss * ss, gfc
>>> *** 9096,9104 ****
>>> /* Walk the parameters of an elemental function. For now we always pass
>>> by reference. */
>>> if (sym->attr.elemental || (comp && comp->attr.elemental))
>>> ! return gfc_walk_elemental_function_args (ss,
>>> expr->value.function.actual,
>>> gfc_get_proc_ifc_for_expr (expr),
>>> GFC_SS_REFERENCE);
>>>
>>> /* Scalar functions are OK as these are evaluated outside the
>>> scalarization
>>> loop. Pass back and let the caller deal with it. */
>>> --- 9102,9114 ----
>>> /* Walk the parameters of an elemental function. For now we always pass
>>> by reference. */
>>> if (sym->attr.elemental || (comp && comp->attr.elemental))
>>> ! {
>>> ! ss = gfc_walk_elemental_function_args (ss,
>>> expr->value.function.actual,
>>> gfc_get_proc_ifc_for_expr (expr),
>>> GFC_SS_REFERENCE);
>>> + if (sym->attr.potentially_aliased)
>>> + ss->info->potentially_aliased = 1;
>>> + }
>>
>> This is somewhat hackish, potentially_aliased is a global thing, not
>> specific to SS, and this may end up marking gfc_ss_terminator as
>> potentiallly_aliased for example, but I don't see any other obvious way
>> to do it, so it's OK I guess.
>>
>> Anyway, the comp && comp->attr.elemental part of the if should be
>> handled too (always set the flag in that case?). I actually wonder why
>> it works without.
>>
>> I attach a few variants of the testcase, which don't work yet.
>>
>> Mikael
>>
>
>
>
> --
> Outside of a dog, a book is a man's best friend. Inside of a dog it's
> too dark to read.
>
> Groucho Marx
--
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.
Groucho Marx
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 220482)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct
*** 789,794 ****
--- 789,798 ----
cannot alias. Note that this is zero for PURE procedures. */
unsigned implicit_pure:1;
+ /* This set for an elemental function that contains expressions for
+ arrays coming from outside its namespace. */
+ unsigned array_outer_dependency:1;
+
/* This is set if the subroutine doesn't return. Currently, this
is only possible for intrinsic subroutines. */
unsigned noreturn:1;
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h (revision 220481)
--- gcc/fortran/trans.h (working copy)
*************** typedef struct gfc_ss_info
*** 226,231 ****
--- 226,235 ----
/* Suppresses precalculation of scalars in WHERE assignments. */
unsigned where:1;
+ /* This set for an elemental function that contains expressions for
+ external arrays, thereby triggering creation of a temporary. */
+ unsigned array_outer_dependency:1;
+
/* Tells whether the SS is for an actual argument which can be a NULL
reference. In other words, the associated dummy argument is OPTIONAL.
Used to handle elemental procedures. */
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c (revision 220481)
--- gcc/fortran/module.c (working copy)
*************** typedef enum
*** 1893,1899 ****
AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
! AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET
}
ab_attribute;
--- 1893,1900 ----
AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
! AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
! AB_ARRAY_OUTER_DEPENDENCY
}
ab_attribute;
*************** static const mstring attr_bits[] =
*** 1949,1954 ****
--- 1950,1956 ----
minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE),
minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY),
minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET),
+ minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY),
minit (NULL, -1)
};
*************** mio_symbol_attribute (symbol_attribute *
*** 2129,2134 ****
--- 2131,2138 ----
MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
if (attr->omp_declare_target)
MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits);
+ if (attr->array_outer_dependency)
+ MIO_NAME (ab_attribute) (AB_ARRAY_OUTER_DEPENDENCY, attr_bits);
mio_rparen ();
*************** mio_symbol_attribute (symbol_attribute *
*** 2295,2300 ****
--- 2299,2307 ----
case AB_OMP_DECLARE_TARGET:
attr->omp_declare_target = 1;
break;
+ case AB_ARRAY_OUTER_DEPENDENCY:
+ attr->array_outer_dependency =1;
+ break;
}
}
}
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 220481)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_function (gfc_expr *expr)
*** 3086,3091 ****
--- 3086,3113 ----
expr->ts = expr->symtree->n.sym->result->ts;
}
+ /* If an elemental function reference is marked as having an
+ external array reference and this function is elemental, it
+ should be so marked as well. */
+ if (gfc_elemental (NULL)
+ && gfc_current_ns->proc_name->attr.function)
+ {
+ /* Check to see if this is a sibling function that has not yet
+ been resolved. */
+ gfc_namespace *sibling = gfc_current_ns->sibling;
+ for (; sibling; sibling = sibling->sibling)
+ {
+ if (sibling->proc_name == sym)
+ {
+ gfc_resolve (sibling);
+ break;
+ }
+ }
+
+ if (sym->attr.array_outer_dependency)
+ gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+ }
+
return t;
}
*************** resolve_variable (gfc_expr *e)
*** 5054,5059 ****
--- 5076,5089 ----
&& gfc_current_ns->parent->parent == sym->ns)))
sym->attr.host_assoc = 1;
+ if (sym->attr.dimension
+ && (sym->ns != gfc_current_ns
+ || sym->attr.use_assoc
+ || sym->attr.in_common)
+ && gfc_elemental (NULL)
+ && gfc_current_ns->proc_name->attr.function)
+ gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+
resolve_procedure:
if (t && !resolve_procedure_expression (e))
t = false;
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 220482)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_resolve_dependencies (gfc_loopi
*** 4391,4396 ****
--- 4391,4402 ----
{
ss_expr = ss->info->expr;
+ if (ss->info->array_outer_dependency)
+ {
+ nDepend = 1;
+ break;
+ }
+
if (ss->info->type != GFC_SS_SECTION)
{
if (flag_realloc_lhs
*************** gfc_walk_function_expr (gfc_ss * ss, gfc
*** 9096,9104 ****
/* Walk the parameters of an elemental function. For now we always pass
by reference. */
if (sym->attr.elemental || (comp && comp->attr.elemental))
! return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
gfc_get_proc_ifc_for_expr (expr),
GFC_SS_REFERENCE);
/* Scalar functions are OK as these are evaluated outside the scalarization
loop. Pass back and let the caller deal with it. */
--- 9102,9115 ----
/* Walk the parameters of an elemental function. For now we always pass
by reference. */
if (sym->attr.elemental || (comp && comp->attr.elemental))
! {
! ss = gfc_walk_elemental_function_args (ss, expr->value.function.actual,
gfc_get_proc_ifc_for_expr (expr),
GFC_SS_REFERENCE);
+ if (sym->attr.array_outer_dependency
+ && ss != gfc_ss_terminator)
+ ss->info->array_outer_dependency = 1;
+ }
/* Scalar functions are OK as these are evaluated outside the scalarization
loop. Pass back and let the caller deal with it. */
Index: gcc/testsuite/gfortran.dg/elemental_dependency_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/elemental_dependency_4.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/elemental_dependency_4.f90 (working copy)
***************
*** 0 ****
--- 1,64 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR64952, in which the assignment to 'array' should
+ ! have generated a temporary because of the references to the lhs in
+ ! the function 'Fred'.
+ !
+ ! Original report, involving function 'Nick'
+ ! Contributed by Nick Maclaren <n...@cam.ac.uk> on clf
+ ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
+ !
+ ! Other tests are due to Mikael Morin <mikael.mo...@sfr.fr>
+ !
+ MODULE M
+ INTEGER, PRIVATE :: i
+ REAL :: arraym(5) = (/ (i+0.0, i = 1,5) /)
+ CONTAINS
+ ELEMENTAL FUNCTION Bill (n, x)
+ REAL :: Bill
+ INTEGER, INTENT(IN) :: n
+ REAL, INTENT(IN) :: x
+ Bill = x+SUM(arraym(:n-1))+SUM(arraym(n+1:))
+ END FUNCTION Bill
+ END MODULE M
+ PROGRAM Main
+ use M
+ INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
+ REAL :: array(5) = (/ (i+0.0, i = 1,5) /)
+
+ ! Original testcase
+ array = Nick(index,array)
+ If (any (array .ne. array(1))) call abort
+
+ ! Check use association of the function works correctly.
+ arraym = Bill(index,arraym)
+ if (any (arraym .ne. arraym(1))) call abort
+
+ ! Check siblings interact correctly.
+ array = (/ (i+0.0, i = 1,5) /)
+ array = Henry(index)
+ if (any (array .ne. array(1))) call abort
+
+ CONTAINS
+ ELEMENTAL FUNCTION Nick (n, x)
+ REAL :: Nick
+ INTEGER, INTENT(IN) :: n
+ REAL, INTENT(IN) :: x
+ Nick = x+SUM(array(:n-1))+SUM(array(n+1:))
+ END FUNCTION Nick
+
+ ! Note that the inverse order of Henry and Henry2 is trivial.
+ ! This way round, Henry2 has to be resolved before Henry can
+ ! be marked as having an inherited external array reference.
+ ELEMENTAL FUNCTION Henry2 (n)
+ REAL :: Henry2
+ INTEGER, INTENT(IN) :: n
+ Henry2 = n + SUM(array(:n-1))+SUM(array(n+1:))
+ END FUNCTION Henry2
+
+ ELEMENTAL FUNCTION Henry (n)
+ REAL :: Henry
+ INTEGER, INTENT(IN) :: n
+ Henry = Henry2(n)
+ END FUNCTION Henry
+ END PROGRAM Main
Index: gcc/testsuite/gfortran.dg/elemental_dependency_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/elemental_dependency_5.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/elemental_dependency_5.f90 (working copy)
***************
*** 0 ****
--- 1,50 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR64952.
+ !
+ ! Original report by Nick Maclaren <n...@cam.ac.uk> on clf
+ ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
+ ! See elemental_dependency_4.f90
+ !
+ ! This test contributed by Mikael Morin <mikael.mo...@sfr.fr>
+ !
+ MODULE M
+ INTEGER, PRIVATE :: i
+
+ TYPE, ABSTRACT :: t
+ REAL :: f
+ CONTAINS
+ PROCEDURE(Fred_ifc), DEFERRED, PASS :: tbp
+ END TYPE t
+ TYPE, EXTENDS(t) :: t2
+ CONTAINS
+ PROCEDURE :: tbp => Fred
+ END TYPE t2
+
+ TYPE(t2) :: array(5) = (/ (t2(i+0.0), i = 1,5) /)
+
+ INTERFACE
+ ELEMENTAL FUNCTION Fred_ifc (x, n)
+ IMPORT
+ REAL :: Fred
+ CLASS(T), INTENT(IN) :: x
+ INTEGER, INTENT(IN) :: n
+ END FUNCTION Fred_ifc
+ END INTERFACE
+
+ CONTAINS
+ ELEMENTAL FUNCTION Fred (x, n)
+ REAL :: Fred
+ CLASS(T2), INTENT(IN) :: x
+ INTEGER, INTENT(IN) :: n
+ Fred = x%f+SUM(array(:n-1)%f)+SUM(array(n+1:)%f)
+ END FUNCTION Fred
+ END MODULE M
+
+ PROGRAM Main
+ USE M
+ INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
+ array%f = array%tbp(index)
+ if (any (array%f .ne. array(1)%f)) call abort
+ END PROGRAM Main
+
