This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[fortran, patch] PR17711 - wrong operator name in error message
- From: Daniel Franke <franke dot daniel at gmail dot com>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Sat, 30 Jun 2007 17:49:23 +0200
- Subject: [fortran, patch] PR17711 - wrong operator name in error message
Due to different operator styles as defined by FORTRAN 77 and Fortran 90,
e. '.eq.' vs. '==', error messages do sometimes not match the operator
specifed in the source.
Attached patch is based on previous work done by Tobias Schlüter [1].
Not related to PR17711, but also fixed in this patch: duplicate/mismatching
definitions of intrinsic operators where not detected:
INTERFACE OPERATOR (.AND.)
MODULE PROCEDURE my_and
END INTERFACE
INTERFACE OPERATOR (.AND.)
MODULE PROCEDURE my_and ! already present
END INTERFACE
INTERFACE OPERATOR (.AND.)
MODULE PROCEDURE my_or ! ambiguous
END INTERFACE
User defined operators where already checked correctly.
:ADDPATCH fortran:
gcc/fortran:
2007-06-30 Daniel Franke <franke.daniel@gmail.com>
Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/17711
* gfortran.h (gfc_intrinsic_op): Added INTRINSIC_EQ_OS,
INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
INTRINSIC_LT_OS and INTRINSIC_LE_OS.
* arith.c (eval_intrinsic, eval_type_intrinsic0): Likewise.
* arith.h (gfc_eq, gfc_ne, gfc_gt, gfc_ge, gfc_lt, gfc_le):
Added gfc_intrinsic_op as third argument type.
* dump-parse-tree.c (gfc_show_expr): Account for new enum
values.
* expr.c (simplify_intrinsic_op, check_intrinsic_op): Likewise.
* interface.c (check_operator_interface): Likewise.
(gfc_check_interfaces): Added cross-checks for FORTRAN 77 and
Fortran 90 style operators using new enum values.
(gfc_extend_expr): Likewise.
(gfc_add_interface): Likewise.
* match.c (intrinsic_operators): Distinguish FORTRAN 77 style
operators from Fortran 90 style operators using new enum values.
* matchexp.c (match_level_4): Account for new enum values.
* module.c (mio_expr): Likewise.
* resolve.c (resolve_operator): Deal with new enum values, fix
inconsistent error messages.
* trans-expr.c (gfc_conv_expr_op): Account for new enum
values.
gcc/testsuite:
2007-06-30 Daniel Franke <franke.daniel@gmail.com>
PR fortran/17711
* gfortran.dg/operator_4.f90: New test.
* gfortran.dg/operator_5.f90: New test.
* gfortran.dg/module_md5_1.f90: Adjusted MD5 sum due to
increased number of operators in module files.
Bootstrapped and regression tested on i686-pc-linux-gnu.
Ok for trunk?
Regards
Daniel
[1] http://gcc.gnu.org/ml/gcc-patches/2006-11/msg01590.html
Index: interface.c
===================================================================
--- interface.c (revision 126130)
+++ interface.c (working copy)
@@ -652,7 +652,9 @@
switch (operator)
{
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
if (t1 == BT_CHARACTER && t2 == BT_CHARACTER)
goto bad_repl;
/* Fall through. */
@@ -667,9 +669,13 @@
break;
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
if (t1 == BT_CHARACTER && t2 == BT_CHARACTER)
goto bad_repl;
if ((t1 == BT_INTEGER || t1 == BT_REAL)
@@ -1117,12 +1123,81 @@
check_operator_interface (ns->operator[i], i);
- for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
- if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
- interface_name, true))
- break;
+ for (ns2 = ns; ns2; ns2 = ns2->parent)
+ {
+ if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
+ interface_name, true))
+ goto done;
+
+ switch (i)
+ {
+ case INTRINSIC_EQ:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_EQ_OS],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_EQ_OS:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_EQ],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_NE:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_NE_OS],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_NE_OS:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_NE],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_GT:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GT_OS],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_GT_OS:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GT],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_GE:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GE_OS],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_GE_OS:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GE],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_LT:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LT_OS],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_LT_OS:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LT],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_LE:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LE_OS],
+ 0, interface_name, true)) goto done;
+ break;
+
+ case INTRINSIC_LE_OS:
+ if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LE],
+ 0, interface_name, true)) goto done;
+ break;
+
+ default:
+ break;
+ }
+ }
}
+done:
gfc_current_ns = old_ns;
}
@@ -2004,7 +2079,56 @@
{
for (ns = gfc_current_ns; ns; ns = ns->parent)
{
- sym = gfc_search_interface (ns->operator[i], 0, &actual);
+ /* Due to the distinction between '==' and '.eq.' and friends, one has
+ to check if either is defined. */
+ switch (i)
+ {
+ case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
+ sym = gfc_search_interface (ns->operator[INTRINSIC_EQ], 0, &actual);
+ if (sym == NULL)
+ sym = gfc_search_interface (ns->operator[INTRINSIC_EQ_OS], 0, &actual);
+ break;
+
+ case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
+ sym = gfc_search_interface (ns->operator[INTRINSIC_NE], 0, &actual);
+ if (sym == NULL)
+ sym = gfc_search_interface (ns->operator[INTRINSIC_NE_OS], 0, &actual);
+ break;
+
+ case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
+ sym = gfc_search_interface (ns->operator[INTRINSIC_GT], 0, &actual);
+ if (sym == NULL)
+ sym = gfc_search_interface (ns->operator[INTRINSIC_GT_OS], 0, &actual);
+ break;
+
+ case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
+ sym = gfc_search_interface (ns->operator[INTRINSIC_GE], 0, &actual);
+ if (sym == NULL)
+ sym = gfc_search_interface (ns->operator[INTRINSIC_GE_OS], 0, &actual);
+ break;
+
+ case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
+ sym = gfc_search_interface (ns->operator[INTRINSIC_LT], 0, &actual);
+ if (sym == NULL)
+ sym = gfc_search_interface (ns->operator[INTRINSIC_LT_OS], 0, &actual);
+ break;
+
+ case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
+ sym = gfc_search_interface (ns->operator[INTRINSIC_LE], 0, &actual);
+ if (sym == NULL)
+ sym = gfc_search_interface (ns->operator[INTRINSIC_LE_OS], 0, &actual);
+ break;
+
+ default:
+ sym = gfc_search_interface (ns->operator[i], 0, &actual);
+ }
+
if (sym != NULL)
break;
}
@@ -2135,10 +2259,55 @@
case INTERFACE_INTRINSIC_OP:
for (ns = current_interface.ns; ns; ns = ns->parent)
- if (check_new_interface (ns->operator[current_interface.op], new)
- == FAILURE)
- return FAILURE;
+ switch (current_interface.op)
+ {
+ case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
+ if (check_new_interface (ns->operator[INTRINSIC_EQ], new) == FAILURE ||
+ check_new_interface (ns->operator[INTRINSIC_EQ_OS], new) == FAILURE)
+ return FAILURE;
+ break;
+ case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
+ if (check_new_interface (ns->operator[INTRINSIC_NE], new) == FAILURE ||
+ check_new_interface (ns->operator[INTRINSIC_NE_OS], new) == FAILURE)
+ return FAILURE;
+ break;
+
+ case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
+ if (check_new_interface (ns->operator[INTRINSIC_GT], new) == FAILURE ||
+ check_new_interface (ns->operator[INTRINSIC_GT_OS], new) == FAILURE)
+ return FAILURE;
+ break;
+
+ case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
+ if (check_new_interface (ns->operator[INTRINSIC_GE], new) == FAILURE ||
+ check_new_interface (ns->operator[INTRINSIC_GE_OS], new) == FAILURE)
+ return FAILURE;
+ break;
+
+ case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
+ if (check_new_interface (ns->operator[INTRINSIC_LT], new) == FAILURE ||
+ check_new_interface (ns->operator[INTRINSIC_LT_OS], new) == FAILURE)
+ return FAILURE;
+ break;
+
+ case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
+ if (check_new_interface (ns->operator[INTRINSIC_LE], new) == FAILURE ||
+ check_new_interface (ns->operator[INTRINSIC_LE_OS], new) == FAILURE)
+ return FAILURE;
+ break;
+
+ default:
+ if (check_new_interface (ns->operator[current_interface.op], new) == FAILURE)
+ return FAILURE;
+ }
+
head = ¤t_interface.ns->operator[current_interface.op];
break;
Index: trans-expr.c
===================================================================
--- trans-expr.c (revision 126130)
+++ trans-expr.c (working copy)
@@ -1079,6 +1079,7 @@
/* EQV and NEQV only work on logicals, but since we represent them
as integers, we can use EQ_EXPR and NE_EXPR for them in GIMPLE. */
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_EQV:
code = EQ_EXPR;
checkstring = 1;
@@ -1086,6 +1087,7 @@
break;
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
case INTRINSIC_NEQV:
code = NE_EXPR;
checkstring = 1;
@@ -1093,24 +1095,28 @@
break;
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
code = GT_EXPR;
checkstring = 1;
lop = 1;
break;
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
code = GE_EXPR;
checkstring = 1;
lop = 1;
break;
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
code = LT_EXPR;
checkstring = 1;
lop = 1;
break;
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
code = LE_EXPR;
checkstring = 1;
lop = 1;
Index: matchexp.c
===================================================================
--- matchexp.c (revision 126130)
+++ matchexp.c (working copy)
@@ -628,7 +628,9 @@
}
if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
- && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT)
+ && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT
+ && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS
+ && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS)
{
gfc_current_locus = old_loc;
*result = left;
@@ -649,27 +651,33 @@
switch (i)
{
case INTRINSIC_EQ:
- r = gfc_eq (left, right);
+ case INTRINSIC_EQ_OS:
+ r = gfc_eq (left, right, i);
break;
case INTRINSIC_NE:
- r = gfc_ne (left, right);
+ case INTRINSIC_NE_OS:
+ r = gfc_ne (left, right, i);
break;
case INTRINSIC_LT:
- r = gfc_lt (left, right);
+ case INTRINSIC_LT_OS:
+ r = gfc_lt (left, right, i);
break;
case INTRINSIC_LE:
- r = gfc_le (left, right);
+ case INTRINSIC_LE_OS:
+ r = gfc_le (left, right, i);
break;
case INTRINSIC_GT:
- r = gfc_gt (left, right);
+ case INTRINSIC_GT_OS:
+ r = gfc_gt (left, right, i);
break;
case INTRINSIC_GE:
- r = gfc_ge (left, right);
+ case INTRINSIC_GE_OS:
+ r = gfc_ge (left, right, i);
break;
default:
Index: dump-parse-tree.c
===================================================================
--- dump-parse-tree.c (revision 126130)
+++ dump-parse-tree.c (working copy)
@@ -472,21 +472,27 @@
gfc_status ("NEQV ");
break;
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
gfc_status ("= ");
break;
case INTRINSIC_NE:
- gfc_status ("<> ");
+ case INTRINSIC_NE_OS:
+ gfc_status ("/= ");
break;
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
gfc_status ("> ");
break;
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
gfc_status (">= ");
break;
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
gfc_status ("< ");
break;
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
gfc_status ("<= ");
break;
case INTRINSIC_NOT:
Index: gfortran.h
===================================================================
--- gfortran.h (revision 126130)
+++ gfortran.h (working copy)
@@ -193,10 +193,14 @@
INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
+ /* ==, /=, >, >=, <, <= */
INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
- INTRINSIC_LT, INTRINSIC_LE, INTRINSIC_NOT, INTRINSIC_USER,
- INTRINSIC_ASSIGN, INTRINSIC_PARENTHESES,
- GFC_INTRINSIC_END /* Sentinel */
+ INTRINSIC_LT, INTRINSIC_LE,
+ /* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style) */
+ INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
+ INTRINSIC_LT_OS, INTRINSIC_LE_OS,
+ INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN,
+ INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */
}
gfc_intrinsic_op;
Index: expr.c
===================================================================
--- expr.c (revision 126130)
+++ expr.c (working copy)
@@ -753,6 +753,7 @@
static try
simplify_intrinsic_op (gfc_expr *p, int type)
{
+ gfc_intrinsic_op op;
gfc_expr *op1, *op2, *result;
if (p->value.op.operator == INTRINSIC_USER)
@@ -760,6 +761,7 @@
op1 = p->value.op.op1;
op2 = p->value.op.op2;
+ op = p->value.op.operator;
if (gfc_simplify_expr (op1, type) == FAILURE)
return FAILURE;
@@ -774,7 +776,7 @@
p->value.op.op1 = NULL;
p->value.op.op2 = NULL;
- switch (p->value.op.operator)
+ switch (op)
{
case INTRINSIC_PARENTHESES:
result = gfc_parentheses (op1);
@@ -813,27 +815,33 @@
break;
case INTRINSIC_EQ:
- result = gfc_eq (op1, op2);
+ case INTRINSIC_EQ_OS:
+ result = gfc_eq (op1, op2, op);
break;
case INTRINSIC_NE:
- result = gfc_ne (op1, op2);
+ case INTRINSIC_NE_OS:
+ result = gfc_ne (op1, op2, op);
break;
case INTRINSIC_GT:
- result = gfc_gt (op1, op2);
+ case INTRINSIC_GT_OS:
+ result = gfc_gt (op1, op2, op);
break;
case INTRINSIC_GE:
- result = gfc_ge (op1, op2);
+ case INTRINSIC_GE_OS:
+ result = gfc_ge (op1, op2, op);
break;
case INTRINSIC_LT:
- result = gfc_lt (op1, op2);
+ case INTRINSIC_LT_OS:
+ result = gfc_lt (op1, op2, op);
break;
case INTRINSIC_LE:
- result = gfc_le (op1, op2);
+ case INTRINSIC_LE_OS:
+ result = gfc_le (op1, op2, op);
break;
case INTRINSIC_NOT:
@@ -1718,11 +1726,17 @@
break;
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
if ((*check_function) (op2) == FAILURE)
return FAILURE;
Index: module.c
===================================================================
--- module.c (revision 126130)
+++ module.c (working copy)
@@ -2568,12 +2568,18 @@
minit ("OR", INTRINSIC_OR),
minit ("EQV", INTRINSIC_EQV),
minit ("NEQV", INTRINSIC_NEQV),
- minit ("EQ", INTRINSIC_EQ),
- minit ("NE", INTRINSIC_NE),
- minit ("GT", INTRINSIC_GT),
- minit ("GE", INTRINSIC_GE),
- minit ("LT", INTRINSIC_LT),
- minit ("LE", INTRINSIC_LE),
+ minit ("==", INTRINSIC_EQ),
+ minit ("EQ", INTRINSIC_EQ_OS),
+ minit ("/=", INTRINSIC_NE),
+ minit ("NE", INTRINSIC_NE_OS),
+ minit (">", INTRINSIC_GT),
+ minit ("GT", INTRINSIC_GT_OS),
+ minit (">=", INTRINSIC_GE),
+ minit ("GE", INTRINSIC_GE_OS),
+ minit ("<", INTRINSIC_LT),
+ minit ("LT", INTRINSIC_LT_OS),
+ minit ("<=", INTRINSIC_LE),
+ minit ("LE", INTRINSIC_LE_OS),
minit ("NOT", INTRINSIC_NOT),
minit ("PARENTHESES", INTRINSIC_PARENTHESES),
minit (NULL, -1)
@@ -2692,11 +2698,17 @@
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
mio_expr (&e->value.op.op1);
mio_expr (&e->value.op.op2);
break;
Index: resolve.c
===================================================================
--- resolve.c (revision 126130)
+++ resolve.c (working copy)
@@ -2203,14 +2203,18 @@
break;
}
- sprintf (msg, _("Operand of .NOT. operator at %%L is %s"),
+ sprintf (msg, _("Operand of .not. operator at %%L is %s"),
gfc_typename (&op1->ts));
goto bad_op;
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX)
{
strcpy (msg, _("COMPLEX quantities cannot be compared at %L"));
@@ -2220,7 +2224,9 @@
/* Fall through... */
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER)
{
e->ts.type = BT_LOGICAL;
@@ -2240,7 +2246,7 @@
if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
sprintf (msg,
_("Logicals at %%L must be compared with %s instead of %s"),
- e->value.op.operator == INTRINSIC_EQ ? ".EQV." : ".NEQV.",
+ e->value.op.operator == INTRINSIC_EQ ? ".eqv." : ".neqv.",
gfc_op2string (e->value.op.operator));
else
sprintf (msg,
@@ -2287,11 +2293,17 @@
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
if (op1->rank == 0 && op2->rank == 0)
e->rank = 0;
Index: match.c
===================================================================
--- match.c (revision 126130)
+++ match.c (working copy)
@@ -44,17 +44,17 @@
minit (".or.", INTRINSIC_OR),
minit (".eqv.", INTRINSIC_EQV),
minit (".neqv.", INTRINSIC_NEQV),
- minit (".eq.", INTRINSIC_EQ),
+ minit (".eq.", INTRINSIC_EQ_OS),
minit ("==", INTRINSIC_EQ),
- minit (".ne.", INTRINSIC_NE),
+ minit (".ne.", INTRINSIC_NE_OS),
minit ("/=", INTRINSIC_NE),
- minit (".ge.", INTRINSIC_GE),
+ minit (".ge.", INTRINSIC_GE_OS),
minit (">=", INTRINSIC_GE),
- minit (".le.", INTRINSIC_LE),
+ minit (".le.", INTRINSIC_LE_OS),
minit ("<=", INTRINSIC_LE),
- minit (".lt.", INTRINSIC_LT),
+ minit (".lt.", INTRINSIC_LT_OS),
minit ("<", INTRINSIC_LT),
- minit (".gt.", INTRINSIC_GT),
+ minit (".gt.", INTRINSIC_GT_OS),
minit (">", INTRINSIC_GT),
minit (".not.", INTRINSIC_NOT),
minit ("parens", INTRINSIC_PARENTHESES),
Index: arith.c
===================================================================
--- arith.c (revision 126130)
+++ arith.c (working copy)
@@ -1539,9 +1539,13 @@
/* Additional restrictions for ordering relations. */
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX)
{
temp.ts.type = BT_LOGICAL;
@@ -1551,7 +1555,9 @@
/* Fall through */
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER)
{
unary = 0;
@@ -1584,7 +1590,10 @@
if (operator == INTRINSIC_EQ || operator == INTRINSIC_NE
|| operator == INTRINSIC_GE || operator == INTRINSIC_GT
- || operator == INTRINSIC_LE || operator == INTRINSIC_LT)
+ || operator == INTRINSIC_LE || operator == INTRINSIC_LT
+ || operator == INTRINSIC_EQ_OS || operator == INTRINSIC_NE_OS
+ || operator == INTRINSIC_GE_OS || operator == INTRINSIC_GT_OS
+ || operator == INTRINSIC_LE_OS || operator == INTRINSIC_LT_OS)
{
temp.ts.type = BT_LOGICAL;
temp.ts.kind = gfc_default_logical_kind;
@@ -1668,11 +1677,17 @@
switch (operator)
{
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
op->ts.type = BT_LOGICAL;
op->ts.kind = gfc_default_logical_kind;
break;
@@ -1861,44 +1876,44 @@
gfc_expr *
-gfc_eq (gfc_expr *op1, gfc_expr *op2)
+gfc_eq (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
{
- return eval_intrinsic_f3 (INTRINSIC_EQ, gfc_arith_eq, op1, op2);
+ return eval_intrinsic_f3 (op, gfc_arith_eq, op1, op2);
}
gfc_expr *
-gfc_ne (gfc_expr *op1, gfc_expr *op2)
+gfc_ne (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
{
- return eval_intrinsic_f3 (INTRINSIC_NE, gfc_arith_ne, op1, op2);
+ return eval_intrinsic_f3 (op, gfc_arith_ne, op1, op2);
}
gfc_expr *
-gfc_gt (gfc_expr *op1, gfc_expr *op2)
+gfc_gt (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
{
- return eval_intrinsic_f3 (INTRINSIC_GT, gfc_arith_gt, op1, op2);
+ return eval_intrinsic_f3 (op, gfc_arith_gt, op1, op2);
}
gfc_expr *
-gfc_ge (gfc_expr *op1, gfc_expr *op2)
+gfc_ge (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
{
- return eval_intrinsic_f3 (INTRINSIC_GE, gfc_arith_ge, op1, op2);
+ return eval_intrinsic_f3 (op, gfc_arith_ge, op1, op2);
}
gfc_expr *
-gfc_lt (gfc_expr *op1, gfc_expr *op2)
+gfc_lt (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
{
- return eval_intrinsic_f3 (INTRINSIC_LT, gfc_arith_lt, op1, op2);
+ return eval_intrinsic_f3 (op, gfc_arith_lt, op1, op2);
}
gfc_expr *
-gfc_le (gfc_expr *op1, gfc_expr *op2)
+gfc_le (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
{
- return eval_intrinsic_f3 (INTRINSIC_LE, gfc_arith_le, op1, op2);
+ return eval_intrinsic_f3 (op, gfc_arith_le, op1, op2);
}
Index: arith.h
===================================================================
--- arith.h (revision 126130)
+++ arith.h (working copy)
@@ -57,12 +57,12 @@
gfc_expr *gfc_not (gfc_expr *);
gfc_expr *gfc_eqv (gfc_expr *, gfc_expr *);
gfc_expr *gfc_neqv (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_eq (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_ne (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_gt (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_ge (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_lt (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_le (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_eq (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_ne (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_gt (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_ge (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_lt (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_le (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
/* Convert strings to literal constants. */
gfc_expr *gfc_convert_integer (const char *, int, int, locus *);