This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
- From: Janus Weil <janus at gcc dot gnu dot org>
- To: gfortran <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 4 Aug 2011 23:42:11 +0200
- Subject: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
Hi all,
attached is a draft patch fixing the PR in the subject line and
extending the checks for overriding type-bound functions. It regtests
cleanly on x86_64-unknown-linux-gnu already, but I would like to have
some feedback.
The patch is rather large, but most of it is just mechanical, due to
the fact that I added an extra argument to 'gfc_dep_compare_expr'. I
use this function to compare the string-length expressions of a
character-valued TBP and an overriding procedure (the standard
requires them to be equal). Inside 'gfc_dep_compare_expr' I had to add
a minor piece to correctly respect commutativity of the multiplication
operator (for the addition operator this was done already). The extra
argument controls whether we check variable symbols for equality or
just their names. For the overriding checks it is sufficient to check
for names, because the arguments of the overriding procedure are
required to have the same names as in the base procedure.
Moreover I extended the type check in 'check_typebound_override' to
also check for correct rank, via 'compare_type_rank' instead of
'gfc_compare_types'. However, the former was local to interface.c, so
I made it public (and should probably also rename it to gfc_...), or
should one rather move 'check_typebound_override' to interface.c
itself? I think it fits in there pretty nicely. After all it is
checking the interfaces of overriding procedures.
Anything else missing for this patch? Or is it ok for trunk? (I will
add corresponding test cases and a ChangeLog, of course.)
Cheers,
Janus
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 177386)
+++ gcc/fortran/interface.c (working copy)
@@ -501,7 +501,7 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec
and types. Returns nonzero if they have the same rank and type,
zero otherwise. */
-static int
+int
compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
{
int r1, r2;
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 177386)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -498,7 +498,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, in
/* If the start and end expressions are equal, the length is one. */
if (ref->u.ss.end
- && gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) == 0)
+ && gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end, false) == 0)
tmp = build_int_cst (gfc_charlen_type_node, 1);
else
{
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 177386)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2822,6 +2822,7 @@ gfc_try gfc_ref_dimen_size (gfc_array_ref *, int d
void gfc_free_interface (gfc_interface *);
int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
int gfc_compare_types (gfc_typespec *, gfc_typespec *);
+int compare_type_rank (gfc_symbol *, gfc_symbol *);
int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
char *, int);
void gfc_check_interfaces (gfc_namespace *);
@@ -2892,7 +2893,7 @@ gfc_namespace* gfc_build_block_ns (gfc_namespace *
/* dependency.c */
int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
-int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
+int gfc_dep_compare_expr (gfc_expr *, gfc_expr *, bool);
/* check.c */
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 177386)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -2552,7 +2552,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_
break;
if (rref && lref
- && gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start) < 0)
+ && gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start, false) < 0)
{
forall_make_variable_temp (c, pre, post);
need_temp = 0;
Index: gcc/fortran/frontend-passes.c
===================================================================
--- gcc/fortran/frontend-passes.c (revision 177386)
+++ gcc/fortran/frontend-passes.c (working copy)
@@ -681,7 +681,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
|| (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
&& op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
{
- eq = gfc_dep_compare_expr (op1, op2);
+ eq = gfc_dep_compare_expr (op1, op2, false);
if (eq == -2)
{
/* Replace A // B < A // C with B < C, and A // B < C // B
@@ -695,7 +695,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
gfc_expr *op1_right = op1->value.op.op2;
gfc_expr *op2_right = op2->value.op.op2;
- if (gfc_dep_compare_expr (op1_left, op2_left) == 0)
+ if (gfc_dep_compare_expr (op1_left, op2_left, false) == 0)
{
/* Watch out for 'A ' // x vs. 'A' // x. */
@@ -722,7 +722,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
return true;
}
}
- if (gfc_dep_compare_expr (op1_right, op2_right) == 0)
+ if (gfc_dep_compare_expr (op1_right, op2_right, false) == 0)
{
free (op1_right);
free (op2_right);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 177386)
+++ gcc/fortran/resolve.c (working copy)
@@ -2585,7 +2585,8 @@ is_scalar_expr_ptr (gfc_expr *expr)
{
case REF_SUBSTRING:
if (ref->u.ss.start == NULL || ref->u.ss.end == NULL
- || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) != 0)
+ || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end,
+ false) != 0)
retval = FAILURE;
break;
@@ -7139,7 +7140,7 @@ resolve_allocate_deallocate (gfc_code *code, const
gfc_array_ref *par = &(pr->u.ar);
gfc_array_ref *qar = &(qr->u.ar);
if (gfc_dep_compare_expr (par->start[0],
- qar->start[0]) != 0)
+ qar->start[0], false) != 0)
break;
}
}
@@ -10672,8 +10673,8 @@ error:
}
-/* Check that it is ok for the typebound procedure proc to override the
- procedure old. */
+/* Check that it is ok for the typebound procedure 'proc' to override the
+ procedure 'old' (F08:4.5.7.3). */
static gfc_try
check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
@@ -10759,16 +10760,27 @@ check_typebound_override (gfc_symtree* proc, gfc_s
return FAILURE;
}
- /* FIXME: Do more comprehensive checking (including, for instance, the
- rank and array-shape). */
+ /* FIXME: Do more comprehensive checking (including, for instance,
+ the array shape). */
gcc_assert (proc_target->result && old_target->result);
- if (!gfc_compare_types (&proc_target->result->ts,
- &old_target->result->ts))
+ if (!compare_type_rank (proc_target->result, old_target->result))
{
gfc_error ("'%s' at %L and the overridden FUNCTION should have"
- " matching result types", proc->name, &where);
+ " matching result types and ranks", proc->name, &where);
return FAILURE;
}
+
+ /* Check string length. */
+ if (proc_target->result->ts.type == BT_CHARACTER
+ && proc_target->result->ts.u.cl && old_target->result->ts.u.cl
+ && gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
+ old_target->result->ts.u.cl->length,
+ true) != 0)
+ {
+ gfc_error ("Character length mismatch between '%s' at '%L' "
+ "and overridden FUNCTION", proc->name, &where);
+ return FAILURE;
+ }
}
/* If the overridden binding is PUBLIC, the overriding one must not be
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 177386)
+++ gcc/fortran/check.c (working copy)
@@ -667,7 +667,7 @@ gfc_var_strlen (const gfc_expr *a)
end_a = mpz_get_si (ra->u.ss.end->value.integer);
return end_a - start_a + 1;
}
- else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end) == 0)
+ else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end, false) == 0)
return 1;
else
return -1;
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c (revision 177386)
+++ gcc/fortran/dependency.c (working copy)
@@ -105,7 +105,7 @@ identical_array_ref (gfc_array_ref *a1, gfc_array_
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)
+ if (gfc_dep_compare_expr (a1->start[i], a2->start[i], false) != 0)
return false;
}
return true;
@@ -163,8 +163,8 @@ gfc_are_identical_variables (gfc_expr *e1, gfc_exp
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)
+ if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start, false) != 0
+ || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end, false) != 0)
return false;
break;
@@ -208,7 +208,7 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
return -2;
if (args1->expr != NULL && args2->expr != NULL
- && gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
+ && gfc_dep_compare_expr (args1->expr, args2->expr, false) != 0)
return -2;
args1 = args1->next;
@@ -221,10 +221,12 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
}
/* 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. */
+ and -2 if the relationship could not be determined. If 'var_name_only' is
+ true, we only check the variable names for equality, not the symbols
+ themselves. */
int
-gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
+gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2, bool var_name_only)
{
gfc_actual_arglist *args1;
gfc_actual_arglist *args2;
@@ -258,31 +260,31 @@ int
if (n1 != NULL)
{
if (n2 != NULL)
- return gfc_dep_compare_expr (n1, n2);
+ return gfc_dep_compare_expr (n1, n2, var_name_only);
else
- return gfc_dep_compare_expr (n1, e2);
+ return gfc_dep_compare_expr (n1, e2, var_name_only);
}
else
{
if (n2 != NULL)
- return gfc_dep_compare_expr (e1, n2);
+ return gfc_dep_compare_expr (e1, n2, var_name_only);
}
if (e1->expr_type == EXPR_OP
&& (e1->value.op.op == INTRINSIC_UPLUS
|| e1->value.op.op == INTRINSIC_PARENTHESES))
- return gfc_dep_compare_expr (e1->value.op.op1, e2);
+ return gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only);
if (e2->expr_type == EXPR_OP
&& (e2->value.op.op == INTRINSIC_UPLUS
|| e2->value.op.op == INTRINSIC_PARENTHESES))
- return gfc_dep_compare_expr (e1, e2->value.op.op1);
+ return gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only);
if (e1->expr_type == EXPR_OP && e1->value.op.op == 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)
+ && gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only) == 0)
return mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P+Q vs. R+S. */
@@ -290,8 +292,8 @@ int
{
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);
+ l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+ r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
if (l == 0 && r == 0)
return 0;
if (l == 0 && r != -2)
@@ -303,8 +305,8 @@ int
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);
+ l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2, var_name_only);
+ r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1, var_name_only);
if (l == 0 && r == 0)
return 0;
if (l == 0 && r != -2)
@@ -323,7 +325,7 @@ int
{
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)
+ && gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only) == 0)
return -mpz_sgn (e2->value.op.op2->value.integer);
}
@@ -332,7 +334,7 @@ int
{
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)
+ && gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only) == 0)
return -mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P-Q vs. R-S. */
@@ -340,8 +342,8 @@ int
{
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);
+ l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+ r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
if (l == 0 && r == 0)
return 0;
if (l != -2 && r == 0)
@@ -362,8 +364,8 @@ int
{
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);
+ l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+ r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
if (l == -2)
return -2;
@@ -396,7 +398,7 @@ int
{
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)
+ && gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only) == 0)
return mpz_sgn (e2->value.op.op2->value.integer);
}
@@ -421,8 +423,10 @@ int
return 1;
case EXPR_VARIABLE:
- if (gfc_are_identical_variables (e1, e2))
+ if (var_name_only && e1->symtree->n.sym->name == e2->symtree->n.sym->name)
return 0;
+ else if (gfc_are_identical_variables (e1, e2))
+ return 0;
else
return -2;
@@ -432,13 +436,18 @@ int
return -2;
if (e1->value.op.op2 == 0)
{
- i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+ i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
return i == 0 ? 0 : -2;
}
- if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
- && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
+ if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only) == 0
+ && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only) == 0)
return 0;
- /* TODO Handle commutative binary operators here? */
+ else if (e1->value.op.op == INTRINSIC_TIMES
+ && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2, var_name_only) == 0
+ && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1, var_name_only) == 0)
+ /* Commutativity of multiplication. */
+ return 0;
+
return -2;
case EXPR_FUNCTION:
@@ -487,7 +496,7 @@ gfc_is_same_range (gfc_array_ref *ar1, gfc_array_r
}
else if (e1 && e2)
{
- i = gfc_dep_compare_expr (e1, e2);
+ i = gfc_dep_compare_expr (e1, e2, false);
if (i == -2)
return def;
else if (i != 0)
@@ -511,7 +520,7 @@ gfc_is_same_range (gfc_array_ref *ar1, gfc_array_r
if (!(e1 && e2))
return def;
- i = gfc_dep_compare_expr (e1, e2);
+ i = gfc_dep_compare_expr (e1, e2, false);
if (i == -2)
return def;
else if (i != 0)
@@ -534,7 +543,7 @@ gfc_is_same_range (gfc_array_ref *ar1, gfc_array_r
if (!(e1 && e2))
return def;
- i = gfc_dep_compare_expr (e1, e2);
+ i = gfc_dep_compare_expr (e1, e2, false);
if (i == -2)
return def;
else if (i != 0)
@@ -1123,7 +1132,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
&& l_stride->ts.type == BT_INTEGER)
l_dir = mpz_sgn (l_stride->value.integer);
else if (l_start && l_end)
- l_dir = gfc_dep_compare_expr (l_end, l_start);
+ l_dir = gfc_dep_compare_expr (l_end, l_start, false);
else
l_dir = -2;
@@ -1134,7 +1143,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
&& r_stride->ts.type == BT_INTEGER)
r_dir = mpz_sgn (r_stride->value.integer);
else if (r_start && r_end)
- r_dir = gfc_dep_compare_expr (r_end, r_start);
+ r_dir = gfc_dep_compare_expr (r_end, r_start, false);
else
r_dir = -2;
@@ -1152,10 +1161,11 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
- r_stride ? r_stride : one_expr);
+ r_stride ? r_stride : one_expr,
+ false);
if (l_start && r_start)
- start_comparison = gfc_dep_compare_expr (l_start, r_start);
+ start_comparison = gfc_dep_compare_expr (l_start, r_start, false);
else
start_comparison = -2;
@@ -1196,13 +1206,13 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
}
/* Check whether the ranges are disjoint. */
- if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
+ if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower, false) == -1)
return GFC_DEP_NODEP;
- if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
+ if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower, false) == -1)
return GFC_DEP_NODEP;
/* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */
- if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
+ if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start, false) == 0)
{
if (l_dir == 1 && r_dir == -1)
return GFC_DEP_EQUAL;
@@ -1211,7 +1221,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
}
/* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */
- if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
+ if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end, false) == 0)
{
if (l_dir == 1 && r_dir == -1)
return GFC_DEP_EQUAL;
@@ -1279,7 +1289,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
of low, which is always at least a forward dependence. */
if (r_dir == 1
- && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
+ && gfc_dep_compare_expr (l_start, l_ar->as->lower[n], false) == 0)
return GFC_DEP_FORWARD;
}
}
@@ -1294,7 +1304,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
of high, which is always at least a forward dependence. */
if (r_dir == -1
- && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
+ && gfc_dep_compare_expr (l_start, l_ar->as->upper[n], false) == 0)
return GFC_DEP_FORWARD;
}
}
@@ -1359,19 +1369,19 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
if (s == 1)
{
/* Check for elem < lower. */
- if (start && gfc_dep_compare_expr (elem, start) == -1)
+ if (start && gfc_dep_compare_expr (elem, start, false) == -1)
return GFC_DEP_NODEP;
/* Check for elem > upper. */
- if (end && gfc_dep_compare_expr (elem, end) == 1)
+ if (end && gfc_dep_compare_expr (elem, end, false) == 1)
return GFC_DEP_NODEP;
if (start && end)
{
- s = gfc_dep_compare_expr (start, end);
+ s = gfc_dep_compare_expr (start, end, false);
/* Check for an empty range. */
if (s == 1)
return GFC_DEP_NODEP;
- if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+ if (s == 0 && gfc_dep_compare_expr (elem, start, false) == 0)
return GFC_DEP_EQUAL;
}
}
@@ -1379,19 +1389,19 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
else if (s == -1)
{
/* Check for elem > upper. */
- if (end && gfc_dep_compare_expr (elem, start) == 1)
+ if (end && gfc_dep_compare_expr (elem, start, false) == 1)
return GFC_DEP_NODEP;
/* Check for elem < lower. */
- if (start && gfc_dep_compare_expr (elem, end) == -1)
+ if (start && gfc_dep_compare_expr (elem, end, false) == -1)
return GFC_DEP_NODEP;
if (start && end)
{
- s = gfc_dep_compare_expr (start, end);
+ s = gfc_dep_compare_expr (start, end, false);
/* Check for an empty range. */
if (s == -1)
return GFC_DEP_NODEP;
- if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+ if (s == 0 && gfc_dep_compare_expr (elem, start, false) == 0)
return GFC_DEP_EQUAL;
}
}
@@ -1400,33 +1410,33 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
{
if (!start || !end)
return GFC_DEP_OVERLAP;
- s = gfc_dep_compare_expr (start, end);
+ s = gfc_dep_compare_expr (start, end, false);
if (s == -2)
return GFC_DEP_OVERLAP;
/* Assume positive stride. */
if (s == -1)
{
/* Check for elem < lower. */
- if (gfc_dep_compare_expr (elem, start) == -1)
+ if (gfc_dep_compare_expr (elem, start, false) == -1)
return GFC_DEP_NODEP;
/* Check for elem > upper. */
- if (gfc_dep_compare_expr (elem, end) == 1)
+ if (gfc_dep_compare_expr (elem, end, false) == 1)
return GFC_DEP_NODEP;
}
/* Assume negative stride. */
else if (s == 1)
{
/* Check for elem > upper. */
- if (gfc_dep_compare_expr (elem, start) == 1)
+ if (gfc_dep_compare_expr (elem, start, false) == 1)
return GFC_DEP_NODEP;
/* Check for elem < lower. */
- if (gfc_dep_compare_expr (elem, end) == -1)
+ if (gfc_dep_compare_expr (elem, end, false) == -1)
return GFC_DEP_NODEP;
}
/* Equal bounds. */
else if (s == 0)
{
- s = gfc_dep_compare_expr (elem, start);
+ s = gfc_dep_compare_expr (elem, start, false);
if (s == 0)
return GFC_DEP_EQUAL;
if (s == 1 || s == -1)
@@ -1532,7 +1542,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_r
r_ar = rref->u.ar;
l_start = l_ar.start[n] ;
r_start = r_ar.start[n] ;
- i = gfc_dep_compare_expr (r_start, l_start);
+ i = gfc_dep_compare_expr (r_start, l_start, false);
if (i == 0)
return GFC_DEP_EQUAL;
@@ -1607,10 +1617,10 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
|| !ref->u.ar.as->lower[i]
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.as->lower[i],
- ref->u.ar.as->upper[i])
+ ref->u.ar.as->upper[i], false)
|| !ref->u.ar.start[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
- ref->u.ar.as->lower[i]))
+ ref->u.ar.as->lower[i], false))
return false;
else
continue;
@@ -1621,14 +1631,14 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
&& (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
- ref->u.ar.as->lower[i])))
+ ref->u.ar.as->lower[i], false)))
lbound_OK = false;
/* Check the upper bound. */
if (ref->u.ar.end[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.end[i],
- ref->u.ar.as->upper[i])))
+ ref->u.ar.as->upper[i], false)))
ubound_OK = false;
/* Check the stride. */
if (ref->u.ar.stride[i]
@@ -1682,10 +1692,10 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref
|| !full_ref->u.ar.as->lower[i]
|| !full_ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
- full_ref->u.ar.as->upper[i])
+ full_ref->u.ar.as->upper[i], false)
|| !ref->u.ar.start[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
- full_ref->u.ar.as->lower[i]))
+ full_ref->u.ar.as->lower[i], false))
return false;
}
@@ -1701,14 +1711,14 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref
&& (ref->u.ar.as
&& full_ref->u.ar.as->lower[i]
&& gfc_dep_compare_expr (ref->u.ar.start[i],
- full_ref->u.ar.as->lower[i]) == 0))
+ full_ref->u.ar.as->lower[i], false) == 0))
upper_or_lower = true;
/* Check the upper bound. */
if (ref->u.ar.end[i]
&& (ref->u.ar.as
&& full_ref->u.ar.as->upper[i]
&& gfc_dep_compare_expr (ref->u.ar.end[i],
- full_ref->u.ar.as->upper[i]) == 0))
+ full_ref->u.ar.as->upper[i], false) == 0))
upper_or_lower = true;
if (!upper_or_lower)
return false;