From patchwork Sat Jan 15 22:45:21 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 79070 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 BD307B6EE8 for ; Sun, 16 Jan 2011 09:45:39 +1100 (EST) Received: (qmail 1759 invoked by alias); 15 Jan 2011 22:45:35 -0000 Received: (qmail 1744 invoked by uid 22791); 15 Jan 2011 22:45:34 -0000 X-SWARE-Spam-Status: No, hits=1.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RCVD_IN_JMF_BL, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 15 Jan 2011 22:45:26 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id AC0FD12180; Sat, 15 Jan 2011 23:45:23 +0100 (CET) Received: from [192.168.0.197] (xdsl-78-35-135-219.netcologne.de [78.35.135.219]) by cc-smtpin3.netcologne.de (Postfix) with ESMTP id 7664011E8E; Sat, 15 Jan 2011 23:45:21 +0100 (CET) Message-ID: <4D322381.5050000@netcologne.de> Date: Sat, 15 Jan 2011 23:45:21 +0100 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.1.16) Gecko/20101125 SUSE/3.0.11 Thunderbird/3.0.11 MIME-Version: 1.0 To: Tobias Burnus CC: "fortran@gcc.gnu.org" , gcc-patches Subject: Re: [patch, fortran] Fix PR 38536 References: <4D317249.30509@netcologne.de> <4D317C83.1020804@net-b.de> In-Reply-To: <4D317C83.1020804@net-b.de> 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 Tobias, here is an update of the patch. This one just warns about array sections if they are followed by component references. Against my earlier patch, this also catches cases like c_loc(ttt%t(5,1:2)%i(1)). Regression-tested. OK for trunk? Thomas 2011-01-15 Thomas Koenig PR fortran/38536 * resolve.c (gfc_iso_c_func_interface): For C_LOC, check for array sections followed by component references which are illegal. Also check for coindexed arguments. 2011-01-15 Thomas Koenig PR fortran/38536 * gfortran.dg/c_loc_tests_16.f90: New test. ! { dg-do compile } ! { dg-options "-fcoarray=single" } ! PR 38536 - array sections as arguments to c_loc are illegal. use iso_c_binding type, bind(c) :: t1 integer(c_int) :: i(5) end type t1 type, bind(c):: t2 type(t1) :: t(5) end type t2 type, bind(c) :: t3 type(t1) :: t(5,5) end type t3 type(t2), target :: tt type(t3), target :: ttt integer(c_int), target :: n(3) integer(c_int), target :: x[*] type(C_PTR) :: p p = c_loc(tt%t%i(1)) ! { dg-error "Array section not permitted" } p = c_loc(n(1:2)) ! { dg-warning "Array section" } p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "Array section not permitted" } p = c_loc(x[1]) ! { dg-error "Coindexed argument not permitted" } end Index: resolve.c =================================================================== --- resolve.c (Revision 168614) +++ resolve.c (Arbeitskopie) @@ -2709,6 +2709,9 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_act } else if (sym->intmod_sym_id == ISOCBINDING_LOC) { + gfc_ref *ref; + bool seen_section; + /* Make sure we have either the target or pointer attribute. */ if (!arg_attr.target && !arg_attr.pointer) { @@ -2719,6 +2722,45 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_act retval = FAILURE; } + if (gfc_is_coindexed (args->expr)) + { + gfc_error_now ("Coindexed argument not permitted" + " in '%s' call at %L", name, + &(args->expr->where)); + retval = FAILURE; + } + + /* Follow references to make sure there are no array + sections. */ + seen_section = false; + + for (ref=args->expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY) + { + if (ref->u.ar.type == AR_SECTION) + seen_section = true; + + if (ref->u.ar.type != AR_ELEMENT) + { + gfc_ref *r; + for (r = ref->next; r; r=r->next) + if (r->type == REF_COMPONENT) + { + gfc_error_now ("Array section not permitted" + " in '%s' call at %L", name, + &(args->expr->where)); + retval = FAILURE; + break; + } + } + } + } + + if (seen_section && retval == SUCCESS) + gfc_warning ("Array section in '%s' call at %L", name, + &(args->expr->where)); + /* See if we have interoperable type and type param. */ if (verify_c_interop (arg_ts) == SUCCESS || gfc_check_any_c_kind (arg_ts) == SUCCESS)