+2015-03-23 Paul Thomas <pault@gcc.gnu.org>
+ Mikael Morin <mikael@gcc.gnu.org>
+
+ PR fortran/64952
+ * gfortran.h (struct symbol_attribute) : New field
+ 'array_outer_dependency'.
+ * trans.h (struct gfc_ss_info): New field 'array_outer_dependency'.
+ * module.c (enum ab_attribute): New value AB_ARRAY_OUTER_DEPENDENCY.
+ (attr_bits): Append same value to initializer.
+ (mio_symbol_attribute): Handle 'array_outer_dependency' attr
+ in module read and write.
+ * resolve.c (update_current_proc_outer_array_dependency): New function.
+ (resolve_function, resolve_call): Add code to update current procedure's
+ 'array_outer_dependency' attribute.
+ (resolve_variable): Mark current procedure with attribute
+ array_outer_dependency if the variable is an array coming from outside
+ the current namespace.
+ (resolve_fl_procedure): Mark a procedure without body with attribute
+ 'array_outer_dependency'.
+ * 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 may reference external arrays,
+ mark the head gfc_ss with flag 'array_outer_dependency'.
+
2015-03-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/59513
cannot alias. Note that this is zero for PURE procedures. */
unsigned implicit_pure:1;
+ /* This is set for a procedure that contains expressions referencing
+ arrays coming from outside its namespace.
+ This is used to force the creation of a temporary when the LHS of
+ an array assignment may be used by an elemental procedure appearing
+ on the RHS. */
+ 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;
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_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
+ AB_ARRAY_OUTER_DEPENDENCY
}
ab_attribute;
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_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 ();
case AB_OMP_DECLARE_TARGET:
attr->omp_declare_target = 1;
break;
+ case AB_ARRAY_OUTER_DEPENDENCY:
+ attr->array_outer_dependency =1;
+ break;
}
}
}
}
+/* Update current procedure's array_outer_dependency flag, considering
+ a call to procedure SYM. */
+
+static void
+update_current_proc_array_outer_dependency (gfc_symbol *sym)
+{
+ /* 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 has references to outer arrays, so has the procedure calling
+ SYM. If SYM is a procedure pointer, we can assume the worst. */
+ if (sym->attr.array_outer_dependency
+ || sym->attr.proc_pointer)
+ gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+}
+
+
/* Resolve a function call, which means resolving the arguments, then figuring
out which entity the name refers to. */
expr->ts = expr->symtree->n.sym->result->ts;
}
+ if (!expr->ref && !expr->value.function.isym)
+ {
+ if (expr->value.function.esym)
+ update_current_proc_array_outer_dependency (expr->value.function.esym);
+ else
+ update_current_proc_array_outer_dependency (sym);
+ }
+ else if (expr->ref)
+ /* typebound procedure: Assume the worst. */
+ gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+
return t;
}
if (!resolve_elemental_actual (NULL, c))
return false;
+ if (!c->expr1)
+ update_current_proc_array_outer_dependency (csym);
+ else
+ /* Typebound procedure: Assume the worst. */
+ gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+
return t;
}
&& gfc_current_ns->parent->parent == sym->ns)))
sym->attr.host_assoc = 1;
+ if (gfc_current_ns->proc_name
+ && sym->attr.dimension
+ && (sym->ns != gfc_current_ns
+ || sym->attr.use_assoc
+ || sym->attr.in_common))
+ gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+
resolve_procedure:
if (t && !resolve_procedure_expression (e))
t = false;
}
}
+ /* Assume that a procedure whose body is not known has references
+ to external arrays. */
+ if (sym->attr.if_source != IFSRC_DECL)
+ sym->attr.array_outer_dependency = 1;
+
return true;
}
{
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
/* 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_ss *old_ss = ss;
+
+ ss = gfc_walk_elemental_function_args (old_ss,
+ expr->value.function.actual,
gfc_get_proc_ifc_for_expr (expr),
GFC_SS_REFERENCE);
+ if (ss != old_ss
+ && (comp
+ || sym->attr.proc_pointer
+ || sym->attr.if_source != IFSRC_DECL
+ || sym->attr.array_outer_dependency))
+ 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. */
/* 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. */
+2015-03-23 Paul Thomas <pault@gcc.gnu.org>
+ Mikael Morin <mikael@gcc.gnu.org>
+
+ PR fortran/64952
+ * gfortran.dg/elemental_dependency_4.f90: New.
+ * gfortran.dg/elemental_dependency_5.f90: New.
+
2015-03-22 Jan Hubicka <hubicka@ucw.cz>
PR ipa/65475
--- /dev/null
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! 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
+
+ ELEMENTAL FUNCTION Charles (x)
+ REAL :: Charles
+ REAL, INTENT(IN) :: x
+ Charles = x
+ END FUNCTION Charles
+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
+
+ array = (/ (i+0.0, i = 1,5) /)
+ ! This should not create a temporary
+ array = Charles(array)
+ If (any (array .ne. index)) call abort
+ ! { dg-final { scan-tree-dump-times "array\\\[\[^\\\]\]*\\\]\\s*=\\s*charles\\s*\\(&array\\\[\[^\\\]\]*\\\]\\);" 1 "original" } }
+
+ ! 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
+
+ array = (/ (i+0.0, i = 1,5) /)
+ ! This should not create a temporary
+ array = index + Henry2(0) - array
+ ! { dg-final { scan-tree-dump-times "array\\\[\[^\\\]\]*\\\]\\s*=\\s*\\(\\(real\\(kind=4\\)\\)\\s*index\\\[\[^\\\]\]*\\\]\\s*\\+\\s*D.\\d*\\)\\s*-\\s*array\\\[\[^\\\]\]*\\\];" 1 "original" } }
+ if (any (array .ne. 15.0)) call abort
+
+ arraym = (/ (i+0.0, i = 1,5) /)
+ arraym = Peter(index, arraym)
+ if (any (arraym .ne. 15.0)) call abort
+
+ array = (/ (i+0.0, i = 1,5) /)
+ array = Robert(index)
+ if (any (arraym .ne. 15.0)) call abort
+
+ missme => Robert2
+ array = (/ (i+0.0, i = 1,5) /)
+ array = David(index)
+ if (any (arraym .ne. 15.0)) call abort
+
+ array = (/ (i+0.0, i = 1,5) /)
+ array = James(index)
+ if (any (arraym .ne. 15.0)) call abort
+
+ array = (/ (i+0.0, i = 1,5) /)
+ array = Romeo(index)
+ 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
+
+! { dg-final { cleanup-tree-dump "original" } }
--- /dev/null
+! { 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
+
projects / gcc.git / commitdiff