From c6d6e62f3e8b13bda76eb8586a5024f4e488cab9 Mon Sep 17 00:00:00 2001
From: "Steven G. Kargl" <kargl@gcc.gnu.org>
Date: Sat, 25 Sep 2010 05:55:59 +0000
Subject: [PATCH] interface.c (gfc_match_end_interface): Deal with user defined
operators that...
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.
From-SVN: r164616
---
gcc/fortran/ChangeLog | 5 ++
gcc/fortran/interface.c | 38 +++++++++--
gcc/testsuite/ChangeLog | 4 ++
gcc/testsuite/gfortran.dg/operator_c1202.f90 | 68 ++++++++++++++++++++
4 files changed, 111 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/operator_c1202.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 97875a5046f8..7b32c5dd038f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+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 Tobias Burnus <burnus@net-b.de>
* gfortran.texi: Add second space after end-of-sentence period;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 5024fe86bdf2..896ad75565ea 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 30ef6fd56908..3815b943618e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2010-09-24 Steven G. Kargl < kargl@gcc.gnu.org>
+
+ * testsuite/gfortran.dg/operator_c1202.f90: New test.
+
2010-09-24 Jan Hubicka <jh@suse.cz>
* gcc.dg/tree-ssa/leaf.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/operator_c1202.f90 b/gcc/testsuite/gfortran.dg/operator_c1202.f90
new file mode 100644
index 000000000000..c53079ac5d84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_c1202.f90
@@ -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
--
GitLab