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 on clf + ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg + ! + ! Other tests are due to Mikael Morin + ! + 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 on clf + ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg + ! See elemental_dependency_4.f90 + ! + ! This test contributed by Mikael Morin + ! + 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 +