From patchwork Sat Aug 13 13:12:19 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janus Weil X-Patchwork-Id: 109932 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 F1FAFB70C3 for ; Sat, 13 Aug 2011 23:12:43 +1000 (EST) Received: (qmail 26108 invoked by alias); 13 Aug 2011 13:12:38 -0000 Received: (qmail 26090 invoked by uid 22791); 13 Aug 2011 13:12:36 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW X-Spam-Check-By: sourceware.org Received: from mail-yi0-f47.google.com (HELO mail-yi0-f47.google.com) (209.85.218.47) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 13 Aug 2011 13:12:20 +0000 Received: by yia28 with SMTP id 28so2629587yia.20 for ; Sat, 13 Aug 2011 06:12:19 -0700 (PDT) MIME-Version: 1.0 Received: by 10.147.16.28 with SMTP id t28mr2067098yai.37.1313241139765; Sat, 13 Aug 2011 06:12:19 -0700 (PDT) Received: by 10.147.137.10 with HTTP; Sat, 13 Aug 2011 06:12:19 -0700 (PDT) In-Reply-To: <4E3EDE78.5050207@netcologne.de> References: <201108061946.35514.mikael.morin@sfr.fr> <4E3D8E2D.7030000@netcologne.de> <4E3DA4B9.3090505@netcologne.de> <4E3DB94B.2050702@netcologne.de> <4E3E6511.4090801@netcologne.de> <4E3E7E2B.9080405@netcologne.de> <4E3EDE78.5050207@netcologne.de> Date: Sat, 13 Aug 2011 15:12:19 +0200 Message-ID: Subject: Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length. From: Janus Weil To: Thomas Koenig Cc: Mikael Morin , fortran@gcc.gnu.org, gcc-patches 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 Hi Thomas, hi all, 2011/8/7 Thomas Koenig : > When extending the values of gfc_dep_compare_expr, we will need to go > through all its uses (making sure we change == -2 to <= -2). attached is a patch which makes a start with this. For now, it changes the return value to "-3" for two cases: 1) different expr_types 2) non-identical variables I tried to take care of all places which are checking for a return value of "-2" and I hope I missed none. Any objections or ok for trunk? (Regtested successfully.) Cheers, Janus 2011-08-13 Janus Weil PR fortran/49638 * dependency.c (gfc_dep_compare_expr): Add new result value "-3". (gfc_check_element_vs_section,gfc_check_element_vs_element): Handle result value "-3". * frontend-passes.c (optimize_comparison): Ditto. * interface.c (gfc_check_typebound_override): Ditto. 2011-08-13 Janus Weil PR fortran/49638 * gfortran.dg/typebound_override_1.f90: Modified. Index: gcc/testsuite/gfortran.dg/typebound_override_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/typebound_override_1.f90 (revision 177733) +++ gcc/testsuite/gfortran.dg/typebound_override_1.f90 (working copy) @@ -23,7 +23,7 @@ module m procedure, nopass :: b => b2 ! { dg-error "should have matching result types and ranks" } procedure, nopass :: c => c2 ! { dg-warning "Possible character length mismatch" } procedure, nopass :: d => d2 ! valid, check for commutativity (+,*) - procedure, nopass :: e => e2 ! { dg-warning "Possible character length mismatch" } + procedure, nopass :: e => e2 ! { dg-error "Character length mismatch" } end type contains Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 177733) +++ gcc/fortran/interface.c (working copy) @@ -3574,7 +3574,8 @@ gfc_check_typebound_override (gfc_symtree* proc, g switch (compval) { case -1: - case 1: + case 1: + case -3: gfc_error ("Character length mismatch between '%s' at '%L' and " "overridden FUNCTION", proc->name, &where); return FAILURE; Index: gcc/fortran/frontend-passes.c =================================================================== --- gcc/fortran/frontend-passes.c (revision 177733) +++ gcc/fortran/frontend-passes.c (working copy) @@ -682,7 +682,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX)) { eq = gfc_dep_compare_expr (op1, op2); - if (eq == -2) + if (eq <= -2) { /* Replace A // B < A // C with B < C, and A // B < C // B with A < C. */ Index: gcc/fortran/dependency.c =================================================================== --- gcc/fortran/dependency.c (revision 177733) +++ gcc/fortran/dependency.c (working copy) @@ -230,8 +230,12 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr return -2; } -/* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2, - and -2 if the relationship could not be determined. */ +/* Compare two expressions. Return values: + * +1 if e1 > e2 + * 0 if e1 == e2 + * -1 if e1 < e2 + * -2 if the relationship could not be determined + * -3 if e1 /= e2, but we cannot tell which one is larger. */ int gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) @@ -304,9 +308,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2); if (l == 0 && r == 0) return 0; - if (l == 0 && r != -2) + if (l == 0 && r > -2) return r; - if (l != -2 && r == 0) + if (l > -2 && r == 0) return l; if (l == 1 && r == 1) return 1; @@ -317,9 +321,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1); if (l == 0 && r == 0) return 0; - if (l == 0 && r != -2) + if (l == 0 && r > -2) return r; - if (l != -2 && r == 0) + if (l > -2 && r == 0) return l; if (l == 1 && r == 1) return 1; @@ -354,9 +358,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2); if (l == 0 && r == 0) return 0; - if (l != -2 && r == 0) + if (l > -2 && r == 0) return l; - if (l == 0 && r != -2) + if (l == 0 && r > -2) return -r; if (l == 1 && r == -1) return 1; @@ -375,8 +379,8 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1); r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2); - if (l == -2) - return -2; + if (l <= -2) + return l; if (l == 0) { @@ -387,7 +391,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) if (e1_left->expr_type == EXPR_CONSTANT && e2_left->expr_type == EXPR_CONSTANT && e1_left->value.character.length - != e2_left->value.character.length) + != e2_left->value.character.length) return -2; else return r; @@ -411,7 +415,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) } if (e1->expr_type != e2->expr_type) - return -2; + return -3; switch (e1->expr_type) { @@ -434,7 +438,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) if (are_identical_variables (e1, e2)) return 0; else - return -2; + return -3; case EXPR_OP: /* Intrinsic operators are the same if their operands are the same. */ @@ -1406,7 +1410,7 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r if (!start || !end) return GFC_DEP_OVERLAP; s = gfc_dep_compare_expr (start, end); - if (s == -2) + if (s <= -2) return GFC_DEP_OVERLAP; /* Assume positive stride. */ if (s == -1) @@ -1553,7 +1557,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_r if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start)) return GFC_DEP_OVERLAP; - if (i != -2) + if (i > -2) return GFC_DEP_NODEP; return GFC_DEP_EQUAL; }