[Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 2585 bytes --]

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  <pault@gcc.gnu.org>

    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  <pault@gcc.gnu.org>

    PR fortran/64952
    * gfortran.dg/finalize_28.f90: New test

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 4023 bytes --]

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  <shapero@uw.edu>
+ !
+ 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" } }

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 3070 bytes --]

Dear All,

Dominique has just flagged up a slight technical problem with the patch...
it's not for this PR :-( Please find the correct patch attached.

Paul

On 8 February 2015 at 12:42, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> 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  <pault@gcc.gnu.org>
>
>     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  <pault@gcc.gnu.org>
>
>     PR fortran/64952
>     * gfortran.dg/finalize_28.f90: New test



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 4865 bytes --]

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;
+ 
    /* 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;
+ 
  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;
+     }
  
    /* 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,23 ----
+ ! { 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'.
+ !
+ ! Contributed by Nick Maclaren  <nmm1@cam.ac.uk> on clf
+ ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
+ !
+ PROGRAM Main
+     INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
+     REAL :: array(5) = (/ (i+0.0, i = 1,5) /)
+     array = Fred(index,array)
+     If (any (array .ne. array(1))) call abort
+ 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

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 4908 bytes --]

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


[-- Attachment #2: test.f90 --]
[-- Type: text/x-fortran, Size: 497 bytes --]

MODULE M
    INTEGER, PRIVATE :: i
    REAL :: array(5) = (/ (i+0.0, i = 1,5) /)
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 MODULE M

PROGRAM Main
    USE M
    INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
    array = Fred(index,array)
    PRINT *, array
END PROGRAM Main



[-- Attachment #3: test2.f90 --]
[-- Type: text/x-fortran, Size: 998 bytes --]

MODULE M
    INTEGER, PRIVATE :: i

    TYPE, ABSTRACT :: t
      REAL :: f
!      PROCEDURE(Fred), POINTER :: p => NULL()
    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
        ! In general, this would be in an external procedure
        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)
    PRINT *, array%f
END PROGRAM Main



[-- Attachment #4: test3.f90 --]
[-- Type: text/x-fortran, Size: 599 bytes --]

PROGRAM Main
    INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
    REAL :: array(5) = (/ (i+0.0, i = 1,5) /)
    array = Fred(index)
    PRINT *, array
CONTAINS
    ELEMENTAL FUNCTION Fred (n)
        REAL :: Fred
        INTEGER, INTENT(IN) :: n
        ! In general, this would be in an external procedure
        Fred = Fred2(n)
    END FUNCTION Fred

    ELEMENTAL FUNCTION Fred2 (n)
        REAL :: Fred2
        INTEGER, INTENT(IN) :: n
        ! In general, this would be in an external procedure
        Fred2 = n + SUM(array(:n-1))+SUM(array(n+1:))
    END FUNCTION Fred2

END PROGRAM Main

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Paul Richard Thomas]

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.morin@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

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 8079 bytes --]

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  <pault@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  <pault@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.thomas@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.morin@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

[-- Attachment #2: resubmit.diff --]
[-- Type: text/plain, Size: 10558 bytes --]

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  <nmm1@cam.ac.uk> on clf
+ ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
+ !
+ ! Other tests are due to Mikael Morin  <mikael.morin@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  <nmm1@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.morin@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
+

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Dominique d'Humières]

Dear Paul,

The patch works as advertised! I have two remarks:

(1) AFAIU there is no need for a temporary for

PROGRAM Main 
    INTEGER :: i, index(5) = (/ (i, i = 1,5) /) 
    REAL :: tmp(5), array(5) = (/ (i+0.0, i = 1,5) /) 
    tmp = Fred(index,array) 
    array = tmp
    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 

However I get

[Book15] f90/bug% gfc elemental_weird_db_2.f90 -Warray-temporaries
elemental_weird_db_2.f90:4:10:

     tmp = Fred(index,array) 
          1
Warning: Creating array temporary at (1) [-Warray-temporaries]

(2) You wrote: « However, this works and has no perceivable effect on Polyhedron timings. ». This is hardly a surprise since the Polyhedron tests don’t use any elemental procedure.

Thanks,

Dominique

> Le 10 févr. 2015 à 23:35, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> 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  <pault@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  <pault@gcc.gnu.org>
> 
>    PR fortran/64952
>    * gfortran.dg/elemental_dependency_4.f90: New test
>    * gfortran.dg/elemental_dependency_5.f90: New test

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Paul Richard Thomas]

Dear Dominique,

> The patch works as advertised! I have two remarks:

Of course it does :-)

>
> (1) AFAIU there is no need for a temporary for

Indeed not. I cannot see how that can be avoided without a much more
elaborate patch. Frankly, I do not see that it would be warranted.
Much better some extra temporaries in corner cases, than wrong code.
>
> PROGRAM Main
>     INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
>     REAL :: tmp(5), array(5) = (/ (i+0.0, i = 1,5) /)
>     tmp = Fred(index,array)
>     array = tmp
>     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
>
> However I get
>
> [Book15] f90/bug% gfc elemental_weird_db_2.f90 -Warray-temporaries
> elemental_weird_db_2.f90:4:10:
>
>      tmp = Fred(index,array)
>           1
> Warning: Creating array temporary at (1) [-Warray-temporaries]
>
> (2) You wrote: << However, this works and has no perceivable effect on Polyhedron timings. >>. This is hardly a surprise since the Polyhedron tests don't use any elemental procedure.

:-) You might have gathered that I didn't check! Within errors, it
didn't affect compile times either.

Thanks for the feedback

Paul

>
> Thanks,
>
> Dominique
>
>> Le 10 févr. 2015 à 23:35, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
>>
>> 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  <pault@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  <pault@gcc.gnu.org>
>>
>>    PR fortran/64952
>>    * gfortran.dg/elemental_dependency_4.f90: New test
>>    * gfortran.dg/elemental_dependency_5.f90: New test
>



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Dominique d'Humières]

Dear Paul,

> Le 11 févr. 2015 à 17:57, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> Dear Dominique,
> 
>> The patch works as advertised! I have two remarks:
> 
> Of course it does :-)

;-)

>> 
>> (1) AFAIU there is no need for a temporary for
> 
> Indeed not. I cannot see how that can be avoided without a much more
> elaborate patch. Frankly, I do not see that it would be warranted.
> Much better some extra temporaries in corner cases, than wrong code.

Agreed.

>> (2) You wrote: << However, this works and has no perceivable effect on Polyhedron timings. >>. This is hardly a surprise since the Polyhedron tests don't use any elemental procedure.
> 
> :-) You might have gathered that I didn't check! Within errors, it
> didn't affect compile times either.

AFAICT, I have only one test in my archives that time elemental functions: pr40581 for which I don’t see any difference with/without your patch.

Looking at bugzilla it seems that Fran Martinez Fadrique is a heavy consumer of elemental procs (see e.g. pr52332).
May be you can ask him to do some timing of his code with/without your patch.

> Thanks for the feedback

You’re welcome!

Dominique

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 4254 bytes --]

Le 10/02/2015 23:35, Paul Richard Thomas a écrit :
> 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.
> 
Hello Paul,

there are still some missing bits.  I updated the testcases.
Comments below.

> 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)

As elemental procedures can call pure procedures (or even impure ones if
they are themselves impure), I'm afraid we have to consider all
procedures, not just elemental ones.
See the case in elemental_dependency_4.f90

> +       && 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)
same here.

> +       && gfc_current_ns->proc_name->attr.function)
There is also the case of subroutines which may be called from an
elemental function.  See elemental_dependency_4.f90

> +     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_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
There is also the case of typebound procedures, see
elemental_dependency_5.f90.
I also tried to generate a case with procedure pointers, but didn't
manage to.

> + 	  && ss != gfc_ss_terminator)

gfc_ss_terminator is a special case; one should compare the old value vs
the new value of SS.
See the case in elemental_dependency_4.f90, this should not need a
temporary:
      array = index + Henry2(0)


> + 	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.  */


Mikael

[-- Attachment #2: elemental_dependency_4.f90 --]
[-- Type: text/x-fortran, Size: 4130 bytes --]

! { 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  <nmm1@cam.ac.uk> on clf
! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
!
! Other tests are due to Mikael Morin  <mikael.morin@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

ELEMENTAL FUNCTION Peter(n, x)
    USE M
    REAL :: Peter
    INTEGER, INTENT(IN) :: n
    REAL, INTENT(IN) :: x
    Peter = Bill(n, x)
END FUNCTION Peter

PROGRAM Main
    use M
    INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
    REAL :: array(5) = (/ (i+0.0, i = 1,5) /)

    INTERFACE
        ELEMENTAL FUNCTION Peter(n, x)
            REAL :: Peter
            INTEGER, INTENT(IN) :: n
            REAL, INTENT(IN) :: x
        END FUNCTION Peter
    END INTERFACE

    PROCEDURE(Robert2), POINTER :: missme => Null()

! 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

    ! This should not create a temporary
    array = (/ (i+0.0, i = 1,5) /)
    array = index + Henry2(0) - array
    if (any (array .ne. 15.0)) call abort

    arraym = (/ (i+0.0, i = 1,5) /)
    arraym = Peter(index, arraym)
    print *, arraym
    !if (any (arraym .ne. 15.0)) call abort

    array = (/ (i+0.0, i = 1,5) /)
    array = Robert(index)
    print *, array
    !if (any (arraym .ne. 15.0)) call abort

    missme => Robert2
    array = (/ (i+0.0, i = 1,5) /)
    array = David(index)
    print *, array
    !if (any (arraym .ne. 15.0)) call abort

    array = (/ (i+0.0, i = 1,5) /)
    array = James(index)
    print *, array
    !if (any (arraym .ne. 15.0)) call abort

    array = (/ (i+0.0, i = 1,5) /)
    array = Romeo(index)
    print *, array
    !if (any (arraym .ne. 15.0)) 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

    PURE FUNCTION Robert2(n)
        REAL :: Robert2
        INTEGER, INTENT(IN) :: n
        Robert2 = Henry(n)
    END FUNCTION Robert2

    ELEMENTAL FUNCTION Robert(n)
        REAL :: Robert
        INTEGER, INTENT(IN) :: n
        Robert = Robert2(n)
    END FUNCTION Robert

    ELEMENTAL FUNCTION David (n)
        REAL :: David
        INTEGER, INTENT(IN) :: n
        David = missme(n)
    END FUNCTION David

    ELEMENTAL SUBROUTINE James2 (o, i)
        REAL, INTENT(OUT) :: o
        INTEGER, INTENT(IN) :: i
        o = Henry(i)
    END SUBROUTINE James2

    ELEMENTAL FUNCTION James(n)
        REAL :: James
        INTEGER, INTENT(IN) :: n
        CALL James2(James, n)
    END FUNCTION James

    FUNCTION Romeo2(n)
        REAL :: Romeo2
        INTEGER, INTENT(in) :: n
        Romeo2 = Henry(n)
    END FUNCTION Romeo2

    IMPURE ELEMENTAL FUNCTION Romeo(n)
        REAL :: Romeo
        INTEGER, INTENT(IN) :: n
        Romeo = Romeo2(n)
    END FUNCTION Romeo
END PROGRAM Main

[-- Attachment #3: elemental_dependency_5.f90 --]
[-- Type: text/x-fortran, Size: 1441 bytes --]

! { dg-do run }
!
! Tests the fix for PR64952.
!
! Original report by Nick Maclaren  <nmm1@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.morin@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

    array%f = index
    call Jack(array)
  CONTAINS
    SUBROUTINE Jack(dummy)
        CLASS(t) :: dummy(:)
        dummy%f = dummy%tbp(index)
        print *, dummy%f
        !if (any (dummy%f .ne. 15.0)) call abort
    END SUBROUTINE
END PROGRAM Main

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Mikael Morin]

Hello Paul,

have you had time to look at this again?

Mikael

Re: [Patch, fortran] PR64952 - Missing temporary in assignment from elemental function

[Paul Richard Thomas]

Dear Mikael,

I have been on the road and have only had time for trivial bits and
pieces. The weather forecast from tomorrow afternoon onwards is not
good and so I think that this patch will get some attention :-)

Cheers

Paul

On 12 March 2015 at 19:04, Mikael Morin <mikael.morin@sfr.fr> wrote:
> Hello Paul,
>
> have you had time to look at this again?
>
> 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