{
if (current_interface.op == INTRINSIC_ASSIGN)
- gfc_error ("Expected 'END INTERFACE ASSIGNMENT (=)' at %C");
+ {
+ m = MATCH_ERROR;
+ gfc_error ("Expected 'END INTERFACE ASSIGNMENT (=)' at %C");
+ }
else
- gfc_error ("Expecting 'END INTERFACE OPERATOR (%s)' at %C",
- gfc_op2string (current_interface.op));
+ {
+ char *s1, *s2;
+ s1 = gfc_op2string (current_interface.op);
+ s2 = gfc_op2string (op);
+
+ /* The following if-statements are used to enforce C1202
+ from F2003. */
+ if ((strcmp(s1, "==") == 0 && strcmp(s2, ".eq.") == 0)
+ || (strcmp(s1, ".eq.") == 0 && strcmp(s2, "==") == 0))
+ break;
+ if ((strcmp(s1, "/=") == 0 && strcmp(s2, ".ne.") == 0)
+ || (strcmp(s1, ".ne.") == 0 && strcmp(s2, "/=") == 0))
+ break;
+ if ((strcmp(s1, "<=") == 0 && strcmp(s2, ".le.") == 0)
+ || (strcmp(s1, ".le.") == 0 && strcmp(s2, "<=") == 0))
+ break;
+ if ((strcmp(s1, "<") == 0 && strcmp(s2, ".lt.") == 0)
+ || (strcmp(s1, ".lt.") == 0 && strcmp(s2, "<") == 0))
+ break;
+ if ((strcmp(s1, ">=") == 0 && strcmp(s2, ".ge.") == 0)
+ || (strcmp(s1, ".ge.") == 0 && strcmp(s2, ">=") == 0))
+ break;
+ if ((strcmp(s1, ">") == 0 && strcmp(s2, ".gt.") == 0)
+ || (strcmp(s1, ".gt.") == 0 && strcmp(s2, ">") == 0))
+ break;
- m = MATCH_ERROR;
+ m = MATCH_ERROR;
+ gfc_error ("Expecting 'END INTERFACE OPERATOR (%s)' at %C, "
+ "but got %s", s1, s2);
+ }
+
}
break;
--- /dev/null
+! { dg-do compile }
+module op
+
+ implicit none
+
+ type a
+ integer i
+ end type a
+
+ type b
+ real i
+ end type b
+
+ interface operator(==)
+ module procedure f1
+ end interface operator(.eq.)
+ interface operator(.eq.)
+ module procedure f2
+ end interface operator(==)
+
+ interface operator(/=)
+ module procedure f1
+ end interface operator(.ne.)
+ interface operator(.ne.)
+ module procedure f2
+ end interface operator(/=)
+
+ interface operator(<=)
+ module procedure f1
+ end interface operator(.le.)
+ interface operator(.le.)
+ module procedure f2
+ end interface operator(<=)
+
+ interface operator(<)
+ module procedure f1
+ end interface operator(.lt.)
+ interface operator(.lt.)
+ module procedure f2
+ end interface operator(<)
+
+ interface operator(>=)
+ module procedure f1
+ end interface operator(.ge.)
+ interface operator(.ge.)
+ module procedure f2
+ end interface operator(>=)
+
+ interface operator(>)
+ module procedure f1
+ end interface operator(.gt.)
+ interface operator(.gt.)
+ module procedure f2
+ end interface operator(>)
+
+ contains
+
+ function f2(x,y)
+ logical f2
+ type(a), intent(in) :: x, y
+ end function f2
+
+ function f1(x,y)
+ logical f1
+ type(b), intent(in) :: x, y
+ end function f1
+
+end module op