aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog11
-rw-r--r--gcc/fortran/dependency.c145
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/dependency_14.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/dependency_15.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/dependency_16.f9012
6 files changed, 184 insertions, 14 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a312507..c6bed78 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2006-04-01 Roger Sayle <roger@eyesopen.com>
+
+ * dependency.c (gfc_dep_compare_expr): Strip parentheses and unary
+ plus operators when comparing expressions. Handle comparisons of
+ the form "X+C vs. X", "X vs. X+C", "X-C vs. X" and "X vs. X-C" where
+ C is an integer constant. Handle comparisons of the form "P+Q vs.
+ R+S" and "P-Q vs. R-S". Handle comparisons of integral extensions
+ specially (increasing functions) so extend(A) > extend(B), when A>B.
+ (gfc_check_element_vs_element): Move test later, so that we ignore
+ the fact that "A < B" or "A > B" when A or B contains a forall index.
+
2006-03-31 Asher Langton <langton2@llnl.gov>
PR fortran/25358
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index ca370b6..c3762bd 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -72,8 +72,112 @@ gfc_expr_is_one (gfc_expr * expr, int def)
int
gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
{
+ gfc_actual_arglist *args1;
+ gfc_actual_arglist *args2;
int i;
+ if (e1->expr_type == EXPR_OP
+ && (e1->value.op.operator == INTRINSIC_UPLUS
+ || e1->value.op.operator == INTRINSIC_PARENTHESES))
+ return gfc_dep_compare_expr (e1->value.op.op1, e2);
+ if (e2->expr_type == EXPR_OP
+ && (e2->value.op.operator == INTRINSIC_UPLUS
+ || e2->value.op.operator == INTRINSIC_PARENTHESES))
+ return gfc_dep_compare_expr (e1, e2->value.op.op1);
+
+ if (e1->expr_type == EXPR_OP
+ && e1->value.op.operator == INTRINSIC_PLUS)
+ {
+ /* Compare X+C vs. X. */
+ if (e1->value.op.op2->expr_type == EXPR_CONSTANT
+ && e1->value.op.op2->ts.type == BT_INTEGER
+ && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+ return mpz_sgn (e1->value.op.op2->value.integer);
+
+ /* Compare P+Q vs. R+S. */
+ if (e2->expr_type == EXPR_OP
+ && e2->value.op.operator == INTRINSIC_PLUS)
+ {
+ int l, r;
+
+ l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+ r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+ if (l == 0 && r == 0)
+ return 0;
+ if (l == 0 && r != -2)
+ return r;
+ if (l != -2 && r == 0)
+ return l;
+ if (l == 1 && r == 1)
+ return 1;
+ if (l == -1 && r == -1)
+ return -1;
+
+ l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
+ r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
+ if (l == 0 && r == 0)
+ return 0;
+ if (l == 0 && r != -2)
+ return r;
+ if (l != -2 && r == 0)
+ return l;
+ if (l == 1 && r == 1)
+ return 1;
+ if (l == -1 && r == -1)
+ return -1;
+ }
+ }
+
+ /* Compare X vs. X+C. */
+ if (e2->expr_type == EXPR_OP
+ && e2->value.op.operator == INTRINSIC_PLUS)
+ {
+ if (e2->value.op.op2->expr_type == EXPR_CONSTANT
+ && e2->value.op.op2->ts.type == BT_INTEGER
+ && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+ return -mpz_sgn (e2->value.op.op2->value.integer);
+ }
+
+ /* Compare X-C vs. X. */
+ if (e1->expr_type == EXPR_OP
+ && e1->value.op.operator == INTRINSIC_MINUS)
+ {
+ if (e1->value.op.op2->expr_type == EXPR_CONSTANT
+ && e1->value.op.op2->ts.type == BT_INTEGER
+ && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+ return -mpz_sgn (e1->value.op.op2->value.integer);
+
+ /* Compare P-Q vs. R-S. */
+ if (e2->expr_type == EXPR_OP
+ && e2->value.op.operator == INTRINSIC_MINUS)
+ {
+ int l, r;
+
+ l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+ r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+ if (l == 0 && r == 0)
+ return 0;
+ if (l != -2 && r == 0)
+ return l;
+ if (l == 0 && r != -2)
+ return -r;
+ if (l == 1 && r == -1)
+ return 1;
+ if (l == -1 && r == 1)
+ return -1;
+ }
+ }
+
+ /* Compare X vs. X-C. */
+ if (e2->expr_type == EXPR_OP
+ && e2->value.op.operator == INTRINSIC_MINUS)
+ {
+ if (e2->value.op.op2->expr_type == EXPR_CONSTANT
+ && e2->value.op.op2->ts.type == BT_INTEGER
+ && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+ return mpz_sgn (e2->value.op.op2->value.integer);
+ }
+
if (e1->expr_type != e2->expr_type)
return -2;
@@ -119,12 +223,29 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
|| e1->value.function.isym != e2->value.function.isym)
return -2;
+ args1 = e1->value.function.actual;
+ args2 = e2->value.function.actual;
+
/* We should list the "constant" intrinsic functions. Those
without side-effects that provide equal results given equal
argument lists. */
switch (e1->value.function.isym->generic_id)
{
case GFC_ISYM_CONVERSION:
+ /* Handle integer extensions specially, as __convert_i4_i8
+ is not only "constant" but also "unary" and "increasing". */
+ if (args1 && !args1->next
+ && args2 && !args2->next
+ && e1->ts.type == BT_INTEGER
+ && args1->expr->ts.type == BT_INTEGER
+ && e1->ts.kind > args1->expr->ts.kind
+ && e2->ts.type == e1->ts.type
+ && e2->ts.kind == e1->ts.kind
+ && args2->expr->ts.type == args1->expr->ts.type
+ && args2->expr->ts.kind == args2->expr->ts.kind)
+ return gfc_dep_compare_expr (args1->expr, args2->expr);
+ break;
+
case GFC_ISYM_REAL:
case GFC_ISYM_LOGICAL:
case GFC_ISYM_DBLE:
@@ -135,18 +256,14 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
}
/* Compare the argument lists for equality. */
- {
- gfc_actual_arglist *args1 = e1->value.function.actual;
- gfc_actual_arglist *args2 = e2->value.function.actual;
- while (args1 && args2)
- {
- if (gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
- return -2;
- args1 = args1->next;
- args2 = args2->next;
- }
- return (args1 || args2) ? -2 : 0;
- }
+ while (args1 && args2)
+ {
+ if (gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
+ return -2;
+ args1 = args1->next;
+ args2 = args2->next;
+ }
+ return (args1 || args2) ? -2 : 0;
default:
return -2;
@@ -904,8 +1021,6 @@ gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
i = gfc_dep_compare_expr (r_start, l_start);
if (i == 0)
return GFC_DEP_EQUAL;
- if (i != -2)
- return GFC_DEP_NODEP;
/* Treat two scalar variables as potentially equal. This allows
us to prove that a(i,:) and a(j,:) have no dependency. See
@@ -920,6 +1035,8 @@ gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
|| contains_forall_index_p (l_start))
return GFC_DEP_OVERLAP;
+ if (i != -2)
+ return GFC_DEP_NODEP;
return GFC_DEP_EQUAL;
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 80d1d7f..6901373 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2006-04-01 Roger Sayle <roger@eyesopen.com>
+
+ * gfortran.dg/dependency_14.f90: New test case.
+ * gfortran.dg/dependency_15.f90: Likewise.
+ * gfortran.dg/dependency_16.f90: Likewise.
+
2006-03-31 Asher Langton <langton2@llnl.gov>
PR fortran/25358
diff --git a/gcc/testsuite/gfortran.dg/dependency_14.f90 b/gcc/testsuite/gfortran.dg/dependency_14.f90
new file mode 100644
index 0000000..71e962c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_14.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+ integer, dimension (4,4) :: a
+ integer :: i
+
+ where (a(i,1:3) .ne. 0)
+ a(i+1,2:4) = 1
+ endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_15.f90 b/gcc/testsuite/gfortran.dg/dependency_15.f90
new file mode 100644
index 0000000..36eb3a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_15.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+ integer, dimension (4,4) :: a
+ integer :: i
+
+ where (a(i,1:3) .ne. 0)
+ a(i-1,2:4) = 1
+ endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_16.f90 b/gcc/testsuite/gfortran.dg/dependency_16.f90
new file mode 100644
index 0000000..b669771
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_16.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+ integer, dimension (4,4) :: a
+ integer :: i
+
+ where (a(i+1,1:3) .ne. 0)
+ a(i+2,2:4) = 1
+ endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
generated by cgit v1.1 at 2024-08-24 09:20:16 +0000