From patchwork Mon Jul 8 19:07:44 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 257591 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 586A52C02CF for ; Tue, 9 Jul 2013 05:08:01 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=O0/uT0E9FqDb509pAvAmUl/LoVmeh+pyEgKV08FtjaqWYD cqzcnDmHj4RUEywlTAdX07HQVMqpYlyLgGDgVkdG7NPUEk8q026sYBThEErt6OD4 bYFhvSGUzsrYKRvLTjQTFjPdEfzyNEPXCqduidrIw+SVZEvw+k6qWbqLQogp0= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=uNzh6slQuYd2l1w+frydFo69L6M=; b=EX0E6vI/tRmZEKZX1Xw6 CRUYTD6H1uk9YrXfspERsoZFVoXqQ9c0MOv4Z5uPpzd3zzyEK6/MligLeFzXG6v1 e6zX7qyjHEVSqN1VuH8OQE9LCvk+B1RMo26wFPwDHJJAcDHq6vAjC0rW44244/et ce4noLFo2oQ2kAQUyhUpNYY= Received: (qmail 20502 invoked by alias); 8 Jul 2013 19:07:55 -0000 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 Received: (qmail 20466 invoked by uid 89); 8 Jul 2013 19:07:49 -0000 X-Spam-SWARE-Status: No, score=-2.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RCVD_IN_HOSTKARMA_NO, TW_FP autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Mon, 08 Jul 2013 19:07:48 +0000 Received: from archimedes.net-b.de (port-92-206-14-23.dynamic.qsc.de [92.206.14.23]) by mx02.qsc.de (Postfix) with ESMTP id D848E27682; Mon, 8 Jul 2013 21:07:44 +0200 (CEST) Message-ID: <51DB0E00.6050000@net-b.de> Date: Mon, 08 Jul 2013 21:07:44 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran, committed] PR57834 - Remove bogus c_f_pointer error X-Virus-Found: No Committed as obvious (Rev. 200794) after regtesting on x86-64-gnu-linux. Without the patch, the following bogus error was shown for -std=f2003/f2008: call C_F_POINTER(cptr, str, [255]) 1 Error: TS 29113: Noninteroperable array FPTR at (1) to C_F_POINTER: Only explicit-size and assumed-size arrays are interoperable Tobias 2013-07-08 Tobias Burnus PR fortran/57834 * check.c (is_c_interoperable): Add special case for c_f_pointer. (explicit-size, gfc_check_c_f_pointer, gfc_check_c_loc): Update call. 2013-07-08 Tobias Burnus PR fortran/57834 * gfortran.dg/c_f_pointer_tests_8.f90: New. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index e531deb..4024cd4 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3650,10 +3650,11 @@ gfc_check_sizeof (gfc_expr *arg) otherwise, it is set to NULL. The msg string can be used in diagnostics. If c_loc is true, character with len > 1 are allowed (cf. Fortran 2003corr5); additionally, assumed-shape/assumed-rank/deferred-shape - arrays are permitted. */ + arrays are permitted. And if c_f_ptr is true, deferred-shape arrays + are permitted. */ static bool -is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc) +is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr) { *msg = NULL; @@ -3734,7 +3735,8 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc) *msg = "Only whole-arrays are interoperable"; return false; } - if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE) + if (!c_f_ptr && ar->as->type != AS_EXPLICIT + && ar->as->type != AS_ASSUMED_SIZE) { *msg = "Only explicit-size and assumed-size arrays are interoperable"; return false; @@ -3750,7 +3752,7 @@ gfc_check_c_sizeof (gfc_expr *arg) { const char *msg; - if (!is_c_interoperable (arg, &msg, false)) + if (!is_c_interoperable (arg, &msg, false, false)) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be an " "interoperable data entity: %s", @@ -3900,7 +3902,7 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) return false; } - if (!is_c_interoperable (fptr, &msg, false) && fptr->rank) + if (!is_c_interoperable (fptr, &msg, false, true)) return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array FPTR " "at %L to C_F_POINTER: %s", &fptr->where, msg); @@ -4029,7 +4031,7 @@ gfc_check_c_loc (gfc_expr *x) return false; } - if (!is_c_interoperable (x, &msg, true)) + if (!is_c_interoperable (x, &msg, true, false)) { if (x->ts.type == BT_CLASS) { --- /dev/null 2013-07-08 12:26:00.282145465 +0200 +++ gcc/gcc/testsuite/gfortran.dg/c_f_pointer_tests_8.f90 2013-07-08 19:15:56.658470682 +0200 @@ -0,0 +1,37 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! +! PR fortran/57834 +! +! (Gave a bogus warning before.) +! +program main + + use iso_c_binding + use iso_fortran_env + + implicit none + + interface + function strerror(errno) bind(C, NAME = 'strerror') + import + type(C_PTR) :: strerror + integer(C_INT), value :: errno + end function + end interface + + integer :: i + type(C_PTR) :: cptr + character(KIND=C_CHAR), pointer :: str(:) + + cptr = strerror(INT(42, KIND = C_INT)) + call C_F_POINTER(cptr, str, [255]) + + do i = 1, SIZE(str) + if (str(i) == C_NULL_CHAR) exit + write (ERROR_UNIT, '(A1)', ADVANCE = 'NO') str(i:i) + enddo + + write (ERROR_UNIT, '(1X)') + +end program main