This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[PATCH, fortran] Enforce F2003 C1202
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Fri, 24 Sep 2010 20:42:44 -0700
- Subject: [PATCH, fortran] Enforce F2003 C1202
After reading C1202, the source code in the testsuite, and
the patch. This is obvious.
2010-09-24 Steven G. Kargl < kargl@gcc.gnu.org>
* fortran/interface.c (gfc_match_end_interface): Deal with user defined
operators that overload rational operators and C1202.
2010-09-24 Steven G. Kargl < kargl@gcc.gnu.org>
* testsuite/gfortran.dg/operator_c1202.f90: New test.
Regression tested on x86_64-*-freebsd.
OK for trunk?
--
Steve
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 164578)
+++ gcc/fortran/interface.c (working copy)
@@ -314,12 +314,42 @@ gfc_match_end_interface (void)
{
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;
Index: gcc/testsuite/gfortran.dg/operator_c1202.f90
===================================================================
--- gcc/testsuite/gfortran.dg/operator_c1202.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/operator_c1202.f90 (revision 0)
@@ -0,0 +1,68 @@
+! { 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