From patchwork Sat Sep 25 03:42:44 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 65715 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 7C997B70DC for ; Sat, 25 Sep 2010 13:43:00 +1000 (EST) Received: (qmail 28613 invoked by alias); 25 Sep 2010 03:42:54 -0000 Received: (qmail 28474 invoked by uid 22791); 25 Sep 2010 03:42:51 -0000 X-SWARE-Spam-Status: No, hits=-2.0 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.208.78.105) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 25 Sep 2010 03:42:46 +0000 Received: from troutmask.apl.washington.edu (localhost.apl.washington.edu [127.0.0.1]) by troutmask.apl.washington.edu (8.14.4/8.14.4) with ESMTP id o8P3giS5080448; Fri, 24 Sep 2010 20:42:44 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.14.4/8.14.4/Submit) id o8P3ginV080447; Fri, 24 Sep 2010 20:42:44 -0700 (PDT) (envelope-from sgk) Date: Fri, 24 Sep 2010 20:42:44 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH, fortran] Enforce F2003 C1202 Message-ID: <20100925034244.GA80437@troutmask.apl.washington.edu> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.4.2.3i Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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? 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