re PR fortran/17711 (Wrong operator name in error message)

gcc/fortran:
2007-07-08  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-07-08  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/logical_comp.f90: Adjusted error messages.
	* gfortran.dg/module_md5_1.f90: Adjusted MD5 sum.


Co-Authored-By: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>

From-SVN: r126468

1 files changed, 177 insertions, 8 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 8591182..b46e114 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -659,7 +659,9 @@ check_operator_interface (gfc_interface *intr, gfc_intrinsic_op operator)
   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.  */
@@ -674,9 +676,13 @@ check_operator_interface (gfc_interface *intr, gfc_intrinsic_op operator)
       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)
@@ -1124,12 +1130,81 @@ gfc_check_interfaces (gfc_namespace *ns)
 
       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;
 }
 
@@ -2199,7 +2274,56 @@ gfc_extend_expr (gfc_expr *e)
     {
       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;
 	}
@@ -2330,9 +2454,54 @@ gfc_add_interface (gfc_symbol *new)
 
     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 = &current_interface.ns->operator[current_interface.op];
       break;