diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 78d50f1ff80..6066312cc5f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,28 @@
+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.
+
 2007-07-08  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/32669
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 9d8428ddca0..5de69d08df0 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1539,9 +1539,13 @@ eval_intrinsic (gfc_intrinsic_op operator,
 
     /* 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 @@ eval_intrinsic (gfc_intrinsic_op operator,
 
     /* 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 @@ eval_intrinsic (gfc_intrinsic_op operator,
 
       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 @@ eval_type_intrinsic0 (gfc_intrinsic_op operator, gfc_expr *op)
   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_neqv (gfc_expr *op1, gfc_expr *op2)
 
 
 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);
 }
 
 
diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
index 99833c1256a..6a8c00656a0 100644
--- a/gcc/fortran/arith.h
+++ b/gcc/fortran/arith.h
@@ -57,12 +57,12 @@ gfc_expr *gfc_or (gfc_expr *, gfc_expr *);
 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 *);
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 5d181e2ab24..f81bf04684b 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -472,21 +472,27 @@ gfc_show_expr (gfc_expr *p)
 	  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:
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 0ca7dbfcae2..d90dd214355 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -766,6 +766,7 @@ gfc_is_constant_expr (gfc_expr *e)
 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)
@@ -773,6 +774,7 @@ simplify_intrinsic_op (gfc_expr *p, int type)
 
   op1 = p->value.op.op1;
   op2 = p->value.op.op2;
+  op  = p->value.op.operator;
 
   if (gfc_simplify_expr (op1, type) == FAILURE)
     return FAILURE;
@@ -787,7 +789,7 @@ simplify_intrinsic_op (gfc_expr *p, int type)
   p->value.op.op1 = NULL;
   p->value.op.op2 = NULL;
 
-  switch (p->value.op.operator)
+  switch (op)
     {
     case INTRINSIC_PARENTHESES:
       result = gfc_parentheses (op1);
@@ -826,27 +828,33 @@ simplify_intrinsic_op (gfc_expr *p, int type)
       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:
@@ -1731,11 +1739,17 @@ check_intrinsic_op (gfc_expr *e, try (*check_function) (gfc_expr *))
       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;
       
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cf2546d1491..42edcd1468e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -198,10 +198,14 @@ typedef enum
   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;
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 85911828d19..b46e1147710 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;
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index cbce358c014..18b943d0427 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -44,17 +44,17 @@ mstring intrinsic_operators[] = {
     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),
diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c
index 6e1a5a4a8d5..f681e66a294 100644
--- a/gcc/fortran/matchexp.c
+++ b/gcc/fortran/matchexp.c
@@ -628,7 +628,9 @@ match_level_4 (gfc_expr **result)
     }
 
   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 @@ match_level_4 (gfc_expr **result)
   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:
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index f48932207f2..701da3fdbb2 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2610,12 +2610,18 @@ static const mstring intrinsics[] =
     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)
@@ -2734,11 +2740,17 @@ mio_expr (gfc_expr **ep)
 	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;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b887d82e8c9..97bcc853c72 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2715,14 +2715,18 @@ resolve_operator (gfc_expr *e)
 	  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"));
@@ -2732,7 +2736,9 @@ resolve_operator (gfc_expr *e)
       /* 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;
@@ -2752,7 +2758,7 @@ resolve_operator (gfc_expr *e)
       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,
@@ -2799,11 +2805,17 @@ resolve_operator (gfc_expr *e)
     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;
@@ -6691,6 +6703,29 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
 		}
 	     }
 	}
+
+      /* PUBLIC interfaces may expose PRIVATE procedures that take types
+	 PRIVATE to the containing module.  */
+      for (iface = sym->generic; iface; iface = iface->next)
+	{
+	  for (arg = iface->sym->formal; arg; arg = arg->next)
+	    {
+	      if (arg->sym
+		  && arg->sym->ts.type == BT_DERIVED
+		  && !arg->sym->ts.derived->attr.use_assoc
+		  && !gfc_check_access (arg->sym->ts.derived->attr.access,
+					arg->sym->ts.derived->ns->default_access))
+		{
+		  gfc_error_now ("Procedure '%s' in PUBLIC interface '%s' at %L takes "
+				 "dummy arguments of '%s' which is PRIVATE",
+				 iface->sym->name, sym->name, &iface->sym->declared_at,
+				 gfc_typename(&arg->sym->ts));
+		  /* Stop this message from recurring.  */
+		  arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+		  return FAILURE;
+		}
+	     }
+	}
     }
 
   /* An external symbol may not have an initializer because it is taken to be
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c9cee1cad34..e1a3a8c454c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1102,6 +1102,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
       /* 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;
@@ -1109,6 +1110,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
       break;
 
     case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
     case INTRINSIC_NEQV:
       code = NE_EXPR;
       checkstring = 1;
@@ -1116,24 +1118,28 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
       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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2c325a0950c..c983b922395 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+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.
+
 2007-07-08  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/32669
diff --git a/gcc/testsuite/gfortran.dg/logical_comp.f90 b/gcc/testsuite/gfortran.dg/logical_comp.f90
index a961b291c3a..208cc4a9e66 100644
--- a/gcc/testsuite/gfortran.dg/logical_comp.f90
+++ b/gcc/testsuite/gfortran.dg/logical_comp.f90
@@ -4,6 +4,6 @@
 
 program foo
   logical :: b
-  b = b .eq. b  ! { dg-error ".EQV. instead of .eq." }
-  b = b .ne. b  ! { dg-error ".NEQV. instead of .ne." }
+  b = b .eq. b  ! { dg-error ".eqv. instead of .eq." }
+  b = b .ne. b  ! { dg-error ".neqv. instead of .ne." }
 end program
diff --git a/gcc/testsuite/gfortran.dg/module_md5_1.f90 b/gcc/testsuite/gfortran.dg/module_md5_1.f90
index 8bf9ddb1eb3..3c4efb0950f 100644
--- a/gcc/testsuite/gfortran.dg/module_md5_1.f90
+++ b/gcc/testsuite/gfortran.dg/module_md5_1.f90
@@ -10,5 +10,5 @@ program test
   use foo
   print *, pi
 end program test
-! { dg-final { scan-module "foo" "MD5:1a6374d65e99c0175c42016a649f79db" } }
+! { dg-final { scan-module "foo" "MD5:22d65c2e261759ab63cb7db9d0a8882b" } }
 ! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_4.f90 b/gcc/testsuite/gfortran.dg/operator_4.f90
new file mode 100644
index 00000000000..39cd7ebdf01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_4.f90
@@ -0,0 +1,100 @@
+! PR 17711 : Verify error message text meets operator in source
+! { dg-do compile }
+
+MODULE mod_t
+  type :: t
+    integer :: x
+  end type
+
+  INTERFACE OPERATOR(==)
+    MODULE PROCEDURE t_eq
+  END INTERFACE
+
+  INTERFACE OPERATOR(/=)
+    MODULE PROCEDURE t_ne
+  END INTERFACE
+
+  INTERFACE OPERATOR(>)
+    MODULE PROCEDURE t_gt
+  END INTERFACE
+
+  INTERFACE OPERATOR(>=)
+    MODULE PROCEDURE t_ge
+  END INTERFACE
+
+  INTERFACE OPERATOR(<)
+    MODULE PROCEDURE t_lt
+  END INTERFACE
+
+  INTERFACE OPERATOR(<=)
+    MODULE PROCEDURE t_le
+  END INTERFACE
+
+CONTAINS
+  LOGICAL FUNCTION t_eq(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_eq = (this%x == other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_ne(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_ne = (this%x /= other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_gt(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_gt = (this%x > other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_ge(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_ge = (this%x >= other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_lt(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_lt = (this%x < other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_le(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_le = (this%x <= other%x)
+  END FUNCTION
+END MODULE
+
+PROGRAM pr17711
+  USE mod_t
+
+  LOGICAL :: A
+  INTEGER :: B
+  TYPE(t) :: C
+
+  A = (A == B)   ! { dg-error "comparison operator '=='" }
+  A = (A.EQ.B)   ! { dg-error "comparison operator '.eq.'" }
+  A = (A /= B)   ! { dg-error "comparison operator '/='" }
+  A = (A.NE.B)   ! { dg-error "comparison operator '.ne.'" }
+  A = (A <= B)   ! { dg-error "comparison operator '<='" }
+  A = (A.LE.B)   ! { dg-error "comparison operator '.le.'" }
+  A = (A <  B)   ! { dg-error "comparison operator '<'" }
+  A = (A.LT.B)   ! { dg-error "comparison operator '.lt.'" }
+  A = (A >= B)   ! { dg-error "comparison operator '>='" }
+  A = (A.GE.B)   ! { dg-error "comparison operator '.ge.'" }
+  A = (A >  B)   ! { dg-error "comparison operator '>'" }
+  A = (A.GT.B)   ! { dg-error "comparison operator '.gt.'" }
+
+  ! this should also work with user defined operators
+  A = (A == C)   ! { dg-error "comparison operator '=='" }
+  A = (A.EQ.C)   ! { dg-error "comparison operator '.eq.'" }
+  A = (A /= C)   ! { dg-error "comparison operator '/='" }
+  A = (A.NE.C)   ! { dg-error "comparison operator '.ne.'" }
+  A = (A <= C)   ! { dg-error "comparison operator '<='" }
+  A = (A.LE.C)   ! { dg-error "comparison operator '.le.'" }
+  A = (A <  C)   ! { dg-error "comparison operator '<'" }
+  A = (A.LT.C)   ! { dg-error "comparison operator '.lt.'" }
+  A = (A >= C)   ! { dg-error "comparison operator '>='" }
+  A = (A.GE.C)   ! { dg-error "comparison operator '.ge.'" }
+  A = (A >  C)   ! { dg-error "comparison operator '>'" }
+  A = (A.GT.C)   ! { dg-error "comparison operator '.gt.'" }
+END PROGRAM
+
+! { dg-final { cleanup-modules "mod_t" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_5.f90 b/gcc/testsuite/gfortran.dg/operator_5.f90
new file mode 100644
index 00000000000..6ce77c8dc4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_5.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-c" }
+
+MODULE mod_t
+  type :: t
+    integer :: x
+  end type
+
+  ! user defined operator
+  INTERFACE OPERATOR(.FOO.)
+    MODULE PROCEDURE t_foo
+  END INTERFACE
+
+  INTERFACE OPERATOR(.FOO.)
+    MODULE PROCEDURE t_foo                  ! { dg-error "already present" }
+  END INTERFACE
+
+  INTERFACE OPERATOR(.FOO.)
+    MODULE PROCEDURE t_bar                  ! { dg-error "Ambiguous interfaces" }
+  END INTERFACE
+
+  ! intrinsic operator
+  INTERFACE OPERATOR(==)
+    MODULE PROCEDURE t_foo
+  END INTERFACE
+
+  INTERFACE OPERATOR(.eq.)
+    MODULE PROCEDURE t_foo                  ! { dg-error "already present" }
+  END INTERFACE
+
+  INTERFACE OPERATOR(==)
+    MODULE PROCEDURE t_bar                  ! { dg-error "Ambiguous interfaces" }
+  END INTERFACE
+
+  INTERFACE OPERATOR(.eq.)
+    MODULE PROCEDURE t_bar                  ! { dg-error "already present" }
+  END INTERFACE
+
+CONTAINS
+  LOGICAL FUNCTION t_foo(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_foo = .FALSE.
+  END FUNCTION
+
+  LOGICAL FUNCTION t_bar(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_bar = .FALSE.
+  END FUNCTION
+END MODULE
+
+! { dg-final { cleanup-modules "mod_t" } }