Commit 40e1ed26 by Thomas Koenig

re PR fortran/65819 (overzealous checking in gfc_check_dependency for identical=true)

2019-07-25  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/65819
	* dependency.h (gfc_dep_resovler): Add optional argument identical.
	* dependency.c (gfc_check_dependency): Do not alway return 1 if
	the symbol is the same. Pass on identical to gfc_dep_resolver.
	(gfc_check_element_vs_element): Whitespace fix.
	(gfc_dep_resolver): Adjust comment for function.  If identical is
	true, return 1 if any overlap has been found.

2019-07-25  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/65819
	* gfortran.dg/dependency_54.f90: New test.

From-SVN: r273807
parent 0dfa7ba1
2019-07-25 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/65819
* dependency.h (gfc_dep_resovler): Add optional argument identical.
* dependency.c (gfc_check_dependency): Do not alway return 1 if
the symbol is the same. Pass on identical to gfc_dep_resolver.
(gfc_check_element_vs_element): Whitespace fix.
(gfc_dep_resolver): Adjust comment for function. If identical is
true, return 1 if any overlap has been found.
2019-07-23 Steven G. Kargl <kargl@gcc.gnu.org> 2019-07-23 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/54072 PR fortran/54072
......
...@@ -1351,13 +1351,10 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical) ...@@ -1351,13 +1351,10 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
return 0; return 0;
} }
if (identical)
return 1;
/* Identical and disjoint ranges return 0, /* Identical and disjoint ranges return 0,
overlapping ranges return 1. */ overlapping ranges return 1. */
if (expr1->ref && expr2->ref) if (expr1->ref && expr2->ref)
return gfc_dep_resolver (expr1->ref, expr2->ref, NULL); return gfc_dep_resolver (expr1->ref, expr2->ref, NULL, identical);
return 1; return 1;
...@@ -1884,6 +1881,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n) ...@@ -1884,6 +1881,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
if (i > -2) if (i > -2)
return GFC_DEP_NODEP; return GFC_DEP_NODEP;
return GFC_DEP_EQUAL; return GFC_DEP_EQUAL;
} }
...@@ -2086,11 +2084,13 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref) ...@@ -2086,11 +2084,13 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
Return value Return value
2 : array references are overlapping but reversal of one or 2 : array references are overlapping but reversal of one or
more dimensions will clear the dependency. more dimensions will clear the dependency.
1 : array references are overlapping. 1 : array references are overlapping, or identical is true and
there is some kind of overlap.
0 : array references are identical or not overlapping. */ 0 : array references are identical or not overlapping. */
int int
gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse) gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse,
bool identical)
{ {
int n; int n;
int m; int m;
...@@ -2124,11 +2124,15 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse) ...@@ -2124,11 +2124,15 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
case REF_ARRAY: case REF_ARRAY:
/* For now, treat all coarrays as dangerous. */
if (lref->u.ar.codimen || rref->u.ar.codimen)
return 1;
if (ref_same_as_full_array (lref, rref)) if (ref_same_as_full_array (lref, rref))
return 0; return identical;
if (ref_same_as_full_array (rref, lref)) if (ref_same_as_full_array (rref, lref))
return 0; return identical;
if (lref->u.ar.dimen != rref->u.ar.dimen) if (lref->u.ar.dimen != rref->u.ar.dimen)
{ {
...@@ -2180,6 +2184,8 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse) ...@@ -2180,6 +2184,8 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
&& lref->u.ar.dimen_type[n] == DIMEN_ELEMENT); && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
this_dep = gfc_check_element_vs_element (rref, lref, n); this_dep = gfc_check_element_vs_element (rref, lref, n);
if (identical && this_dep == GFC_DEP_EQUAL)
this_dep = GFC_DEP_OVERLAP;
} }
/* If any dimension doesn't overlap, we have no dependency. */ /* If any dimension doesn't overlap, we have no dependency. */
...@@ -2240,6 +2246,9 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse) ...@@ -2240,6 +2246,9 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
know the worst one.*/ know the worst one.*/
update_fin_dep: update_fin_dep:
if (identical && this_dep == GFC_DEP_EQUAL)
this_dep = GFC_DEP_OVERLAP;
if (this_dep > fin_dep) if (this_dep > fin_dep)
fin_dep = this_dep; fin_dep = this_dep;
} }
...@@ -2253,7 +2262,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse) ...@@ -2253,7 +2262,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
/* Exactly matching and forward overlapping ranges don't cause a /* Exactly matching and forward overlapping ranges don't cause a
dependency. */ dependency. */
if (fin_dep < GFC_DEP_BACKWARD) if (fin_dep < GFC_DEP_BACKWARD && !identical)
return 0; return 0;
/* Keep checking. We only have a dependency if /* Keep checking. We only have a dependency if
...@@ -2267,11 +2276,14 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse) ...@@ -2267,11 +2276,14 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
rref = rref->next; rref = rref->next;
} }
/* Assume the worst if we nest to different depths. */
if (lref || rref)
return 1;
/* If we haven't seen any array refs then something went wrong. */ /* If we haven't seen any array refs then something went wrong. */
gcc_assert (fin_dep != GFC_DEP_ERROR); gcc_assert (fin_dep != GFC_DEP_ERROR);
/* Assume the worst if we nest to different depths. */ if (identical && fin_dep != GFC_DEP_NODEP)
if (lref || rref)
return 1; return 1;
return fin_dep == GFC_DEP_OVERLAP; return fin_dep == GFC_DEP_OVERLAP;
......
...@@ -37,7 +37,8 @@ int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *, ...@@ -37,7 +37,8 @@ int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
int gfc_check_dependency (gfc_expr *, gfc_expr *, bool); int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
int gfc_expr_is_one (gfc_expr *, int); int gfc_expr_is_one (gfc_expr *, int);
int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *); int gfc_dep_resolver (gfc_ref *, gfc_ref *, gfc_reverse *,
bool identical = false);
int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *); int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
gfc_expr * gfc_discard_nops (gfc_expr *); gfc_expr * gfc_discard_nops (gfc_expr *);
2019-07-25 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/65819
* gfortran.dg/dependency_54.f90: New test.
2019-07-25 Eric Botcazou <ebotcazou@adacore.com> 2019-07-25 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/case_optimization3.ad[sb]: New test. * gnat.dg/case_optimization3.ad[sb]: New test.
......
! { dg-do run }
! { dg-additional-options "-fdump-tree-original -ffrontend-optimize" }
! PR 65819 - this used to cause a temporary in matmul inlining.
! Check that these are absent by looking for the names of the
! temporary variables.
program main
implicit none
real, dimension(3,3,3) :: f
real, dimension(3,3) :: res
real, dimension(2,3,3) :: backup
integer :: three
integer :: i
data f(1,:,:) /9*-42./
data f(2:3,:,:) /2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61/
data res /652, 772, 984, 2010, 2406, 3082, 3402, 4086, 5242/
three = 3
backup = f(2:3,:,:)
f(1, 1:three, :) = matmul(f(2,1:3,2:3), f(3,2:3,:))
if (any (res /= f(1,:,:))) stop 1
if (any (f(2:3,:,:) /= backup)) stop 2
end program main
! { dg-final { scan-tree-dump-not "mma" "original" } }
! { dg-final { scan-tree-dump-not "mmb" "original" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment