From patchwork Mon Oct 3 21:02:15 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janus Weil X-Patchwork-Id: 117508 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 942B6B6F75 for ; Tue, 4 Oct 2011 08:02:36 +1100 (EST) Received: (qmail 13372 invoked by alias); 3 Oct 2011 21:02:32 -0000 Received: (qmail 13355 invoked by uid 22791); 3 Oct 2011 21:02:30 -0000 X-SWARE-Spam-Status: No, hits=-2.0 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-yw0-f47.google.com (HELO mail-yw0-f47.google.com) (209.85.213.47) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 03 Oct 2011 21:02:15 +0000 Received: by ywf7 with SMTP id 7so4509224ywf.20 for ; Mon, 03 Oct 2011 14:02:15 -0700 (PDT) MIME-Version: 1.0 Received: by 10.236.132.81 with SMTP id n57mr2507222yhi.47.1317675735121; Mon, 03 Oct 2011 14:02:15 -0700 (PDT) Received: by 10.147.114.1 with HTTP; Mon, 3 Oct 2011 14:02:15 -0700 (PDT) Date: Mon, 3 Oct 2011 23:02:15 +0200 Message-ID: Subject: [Patch, Fortran] PR 35831: [F95] Shape mismatch check missing for dummy procedure argument From: Janus Weil To: gfortran , 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 all, here is a patch for a rather long-standing PR. It continues my ongoing campaign of improving the checks for "procedure characteristics" (cf. F08 chapter 12.3), which are relevant for dummy procedures, procedure pointer assignments, overriding of type-bound procedures, etc. This particular patch checks for the correct shape of array arguments, in a manner similar to the recently added check for the string length (PR 49638), namely via 'gfc_dep_compare_expr'. The hardest thing about this PR was to find out what exactly the standard requires (cf. c.l.f. thread linked in comment #12): Only the shape of the argument has to match (i.e. upper minus lower bound), not the bounds themselves (no matter if the bounds are constant or not). I also added a FIXME, in order to remind myself of adding the same check for function results soon. The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? Cheers, Janus 2011-10-03 Janus Weil PR fortran/35831 * interface.c (check_dummy_characteristics): Check the array shape. 2011-10-03 Janus Weil PR fortran/35831 * gfortran.dg/dummy_procedure_6.f90: New. Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 179468) +++ gcc/fortran/interface.c (working copy) @@ -69,6 +69,7 @@ along with GCC; see the file COPYING3. If not see #include "system.h" #include "gfortran.h" #include "match.h" +#include "arith.h" /* The current_interface structure holds information about the interface currently being parsed. This structure is saved and @@ -1071,13 +1072,51 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_s /* Check array shape. */ if (s1->as && s2->as) { + int i, compval; + gfc_expr *shape1, *shape2; + if (s1->as->type != s2->as->type) { snprintf (errmsg, err_len, "Shape mismatch in argument '%s'", s1->name); return FAILURE; } - /* FIXME: Check exact shape. */ + + if (s1->as->type == AS_EXPLICIT) + for (i = 0; i < s1->as->rank + s1->as->corank; i++) + { + shape1 = gfc_subtract (gfc_copy_expr (s1->as->upper[i]), + gfc_copy_expr (s1->as->lower[i])); + shape2 = gfc_subtract (gfc_copy_expr (s2->as->upper[i]), + gfc_copy_expr (s2->as->lower[i])); + compval = gfc_dep_compare_expr (shape1, shape2); + gfc_free_expr (shape1); + gfc_free_expr (shape2); + switch (compval) + { + case -1: + case 1: + case -3: + snprintf (errmsg, err_len, "Shape mismatch in dimension %i of " + "argument '%s'", i, s1->name); + return FAILURE; + + case -2: + /* FIXME: Implement a warning for this case. + gfc_warning ("Possible shape mismatch in argument '%s'", + s1->name);*/ + break; + + case 0: + break; + + default: + gfc_internal_error ("check_dummy_characteristics: Unexpected " + "result %i of gfc_dep_compare_expr", + compval); + break; + } + } } return SUCCESS; @@ -1131,6 +1170,8 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol "of '%s'", name2); return 0; } + + /* FIXME: Check array bounds and string length of result. */ } if (s1->attr.pure && !s2->attr.pure)