OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/36854 ([meta-bug] fortran front-end optimization)

Browse Source 
2010-08-02  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36854
	* dependency.h:  Add prototype for gfc_are_identical_variables.
	* frontend-passes.c:  Include depencency.h.
	(optimimize_equality):  Use gfc_are_identical_variables.
	* dependency.c (identical_array_ref): New function.
	(gfc_are_identical_variables):  New function.
	(gfc_deb_compare_expr):  Use gfc_are_identical_variables.
	* dependency.c (gfc_check_section_vs_section).  Rename gfc_
	prefix from statc function.
	(check_section_vs_section): Change arguments to gfc_array_ref,
	adjust function body accordingly.

2010-08-02  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36854
	* gfortran.dg/character_comparison_2.f90:  New test.
	* gfortran.dg/character_comparison_3.f90:  New test.
	* gfortran.dg/dependency_28.f90:  New test.

From-SVN: r162824
This commit is contained in:
Thomas Koenig 2010-08-02 16:53:51 +00:00
parent 20769d5eb6
commit 071bdb5f22
8 changed files with 249 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
2010-08-02 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36854
* dependency.h: Add prototype for gfc_are_identical_variables.
* frontend-passes.c: Include depencency.h.
(optimimize_equality): Use gfc_are_identical_variables.
* dependency.c (identical_array_ref): New function.
(gfc_are_identical_variables): New function.
(gfc_deb_compare_expr): Use gfc_are_identical_variables.
* dependency.c (gfc_check_section_vs_section). Rename gfc_
prefix from statc function.
(check_section_vs_section): Change arguments to gfc_array_ref,
adjust function body accordingly.
2010-08-02 Mikael Morin <mikael@gcc.gnu.org>
Janus Weil <janus@gcc.gnu.org>

149
gcc/fortran/dependency.c
View File

@ -49,6 +49,10 @@ gfc_dependency;
/* Macros */
#define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
/* Forward declarations */
static gfc_dependency check_section_vs_section (gfc_array_ref *,
gfc_array_ref *, int);
/* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
def if the value could not be determined. */
@ -67,6 +71,105 @@ gfc_expr_is_one (gfc_expr *expr, int def)
return mpz_cmp_si (expr->value.integer, 1) == 0;
}
/* Check if two array references are known to be identical. Calls
gfc_dep_compare_expr if necessary for comparing array indices. */
static bool
identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2)
{
int i;
if (a1->type == AR_FULL && a2->type == AR_FULL)
return true;
if (a1->type == AR_SECTION && a2->type == AR_SECTION)
{
gcc_assert (a1->dimen == a2->dimen);
for ( i = 0; i < a1->dimen; i++)
{
/* TODO: Currently, we punt on an integer array as an index. */
if (a1->dimen_type[i] != DIMEN_RANGE
|| a2->dimen_type[i] != DIMEN_RANGE)
return false;
if (check_section_vs_section (a1, a2, i) != GFC_DEP_EQUAL)
return false;
}
return true;
}
if (a1->type == AR_ELEMENT && a2->type == AR_ELEMENT)
{
gcc_assert (a1->dimen == a2->dimen);
for (i = 0; i < a1->dimen; i++)
{
if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
return false;
}
return true;
}
return false;
}
/* Return true for identical variables, checking for references if
necessary. Calls identical_array_ref for checking array sections. */
bool
gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2)
{
gfc_ref *r1, *r2;
if (e1->symtree->n.sym != e2->symtree->n.sym)
return false;
r1 = e1->ref;
r2 = e2->ref;
while (r1 != NULL || r2 != NULL)
{
/* Assume the variables are not equal if one has a reference and the
other doesn't.
TODO: Handle full references like comparing a(:) to a.
*/
if (r1 == NULL || r2 == NULL)
return false;
if (r1->type != r2->type)
return false;
switch (r1->type)
{
case REF_ARRAY:
if (!identical_array_ref (&r1->u.ar, &r2->u.ar))
return false;
break;
case REF_COMPONENT:
if (r1->u.c.component != r2->u.c.component)
return false;
break;
case REF_SUBSTRING:
if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0
|| gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
return false;
break;
default:
gfc_internal_error ("gfc_are_identical_variables: Bad type");
}
r1 = r1->next;
r2 = r2->next;
}
return true;
}
/* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
and -2 if the relationship could not be determined. */
@ -191,11 +294,10 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
return 1;
case EXPR_VARIABLE:
if (e1->ref || e2->ref)
return -2;
if (e1->symtree->n.sym == e2->symtree->n.sym)
if (gfc_are_identical_variables (e1, e2))
return 0;
return -2;
else
return -2;
case EXPR_OP:
/* Intrinsic operators are the same if their operands are the same. */
@ -882,9 +984,8 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
/* Determines overlapping for two array sections. */
static gfc_dependency
gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n)
check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
{
gfc_array_ref l_ar;
gfc_expr *l_start;
gfc_expr *l_end;
gfc_expr *l_stride;
@ -892,7 +993,6 @@ gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n)
gfc_expr *l_upper;
int l_dir;
gfc_array_ref r_ar;
gfc_expr *r_start;
gfc_expr *r_end;
gfc_expr *r_stride;
@ -900,34 +1000,31 @@ gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n)
gfc_expr *r_upper;
int r_dir;
l_ar = lref->u.ar;
r_ar = rref->u.ar;
/* If they are the same range, return without more ado. */
if (gfc_is_same_range (&l_ar, &r_ar, n, 0))
if (gfc_is_same_range (l_ar, r_ar, n, 0))
return GFC_DEP_EQUAL;
l_start = l_ar.start[n];
l_end = l_ar.end[n];
l_stride = l_ar.stride[n];
l_start = l_ar->start[n];
l_end = l_ar->end[n];
l_stride = l_ar->stride[n];
r_start = r_ar.start[n];
r_end = r_ar.end[n];
r_stride = r_ar.stride[n];
r_start = r_ar->start[n];
r_end = r_ar->end[n];
r_stride = r_ar->stride[n];
/* If l_start is NULL take it from array specifier. */
if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar.as))
l_start = l_ar.as->lower[n];
if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar->as))
l_start = l_ar->as->lower[n];
/* If l_end is NULL take it from array specifier. */
if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar.as))
l_end = l_ar.as->upper[n];
if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar->as))
l_end = l_ar->as->upper[n];
/* If r_start is NULL take it from array specifier. */
if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
r_start = r_ar.as->lower[n];
if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar->as))
r_start = r_ar->as->lower[n];
/* If r_end is NULL take it from array specifier. */
if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
r_end = r_ar.as->upper[n];
if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar->as))
r_end = r_ar->as->upper[n];
/* Determine whether the l_stride is positive or negative. */
if (!l_stride)
@ -1574,7 +1671,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
&& rref->u.ar.dimen_type[n] == DIMEN_RANGE)
this_dep = gfc_check_section_vs_section (lref, rref, n);
this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
&& rref->u.ar.dimen_type[n] == DIMEN_RANGE)
this_dep = gfc_check_element_vs_section (lref, rref, n);

2
gcc/fortran/dependency.h
View File

@ -43,3 +43,5 @@ int gfc_expr_is_one (gfc_expr *, int);
int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *);
int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
bool gfc_are_identical_variables (gfc_expr *, gfc_expr *);

10
gcc/fortran/frontend-passes.c
View File

@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see
#include "gfortran.h"
#include "arith.h"
#include "flags.h"
#include "dependency.h"
/* Forward declarations. */
@ -398,14 +399,13 @@ optimize_equality (gfc_expr *e, bool equal)
return true;
}
/* Check for direct comparison between identical variables.
TODO: Handle cases with identical refs. */
/* Check for direct comparison between identical variables. Don't compare
REAL or COMPLEX because of NaN checks. */
if (op1->expr_type == EXPR_VARIABLE
&& op2->expr_type == EXPR_VARIABLE
&& op1->symtree == op2->symtree
&& op1->ref == NULL && op2->ref == NULL
&& op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
&& op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX)
&& op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX
&& gfc_are_identical_variables (op1, op2))
{
/* Replace the expression by a constant expression. The typespec
and where remains the way it is. */

14
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,17 @@
2010-08-02 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36854
* dependency.h: Add prototype for gfc_are_identical_variables.
* frontend-passes.c: Include depencency.h.
(optimimize_equality): Use gfc_are_identical_variables.
* dependency.c (identical_array_ref): New function.
(gfc_are_identical_variables): New function.
(gfc_deb_compare_expr): Use gfc_are_identical_variables.
* dependency.c (gfc_check_section_vs_section). Rename gfc_
prefix from statc function.
(check_section_vs_section): Change arguments to gfc_array_ref,
adjust function body accordingly.
2010-08-02 Bernd Schmidt <bernds@codesourcery.com>
PR target/40457

40
gcc/testsuite/gfortran.dg/character_comparison_2.f90 Normal file
View File

@ -0,0 +1,40 @@
! { dg-do run }
! { dg-options "-O -fdump-tree-original" }
program main
implicit none
character(len=4) :: c
integer :: n
integer :: i
integer :: k1, k2
common /foo/ i
n = 0
i = 0
k1 = 1
k2 = 3
c = 'abcd'
n = n + 1 ; if (c(1:2) == c(1:2)) call yes
n = n + 1 ; if (c(k1:k2) >= c(k1:k2)) call yes
n = n + 1 ; if (c(:2) <= c(1:2)) call yes
n = n + 1 ; if (c(k2:) .eq. c(k2:4)) call yes
n = n + 1 ; if (c(:) .ge. c) call yes
n = n + 1 ; if (c .le. c) call yes
if (c(1:2) /= c(1:2)) call abort
if (c(k1:k2) > c(k1:k2)) call abort
if (c(:2) < c(1:2)) call abort
if (c(:) .ne. c) call abort
if (c(:2) .gt. c(1:2)) call abort
if (c(1:2) .lt. c(:2)) call abort
if (n /= i) call abort
end program main
subroutine yes
implicit none
common /foo/ i
integer :: i
i = i + 1
end subroutine yes
! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

30
gcc/testsuite/gfortran.dg/character_comparison_3.f90 Normal file
View File

@ -0,0 +1,30 @@
! { dg-do run }
! { dg-options "-fdump-tree-original" }
program main
implicit none
character(len=4) :: c
integer :: i
integer :: k1, k2, k3, k4, k11, k22, k33, k44
k1 = 1
k2 = 2
k3 = 3
k4 = 4
k11 = 1
k22 = 2
k33 = 3
k44 = 4
c = 'abcd'
if (c(2:) /= c(k2:k4)) call abort
if (c(k2:k4) /= c(k22:)) call abort
if (c(2:3) == c(1:2)) call abort
if (c(1:2) == c(2:3)) call abort
if (c(k1:) == c(k2:)) call abort
if (c(:3) == c(:k4)) call abort
if (c(:k4) == c(:3)) call abort
if (c(:k3) == c(:k44)) call abort
end program main
! { dg-final { scan-tree-dump-times "gfortran_compare_string" 8 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

21
gcc/testsuite/gfortran.dg/dependency_28.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do compile }
! { dg-options "-Warray-temporaries" }
module foobar
type baz
integer :: i
integer :: j
integer :: k
integer :: m
end type baz
contains
subroutine foo(a,b,c,i)
real, dimension(10) :: a,b
type(baz) :: c
integer, dimension(10) :: i
a(i(1):i(2)) = a(i(1):i(2)) + b(i(1):i(2))
a(i(1):i(2)) = a(i(3):i(5)) ! { dg-warning "Creating array temporary" }
a(c%i:c%j) = a(c%i:c%j) + b(c%k:c%m)
a(c%k:c%m) = a(c%i:c%j) + b(c%k:c%m) ! { dg-warning "Creating array temporary" }
end subroutine foo
end module foobar
! { dg-final { cleanup-modules "foobar" } }