From patchwork Wed Oct 23 13:07:27 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1182148 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-511581-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="onHAUYaS"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 46yrJd5ybXz9sPF for ; Thu, 24 Oct 2019 00:07:44 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=qXfYU03qhPEUAeYKrjCt5cXtx4NJo+er08FLzzmkEEWi2yqkf6 OtLAm0V/R6W2DIlfo9SJ8Pavt0qT3fZPYay66qbPeivzPCqQayUpnRfa1fnKNZ+q /G2Wk4iz0NuyEV/Awb4oCDY1KMwJPWi0ywuUuKWlbkUUOzpLWf7rVZoJg= 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:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=0biqdGqXlgVcFppJftqUEMGer0A=; b=onHAUYaSL3HXToPVN09l eZlWSt23mYsy7ohFXZkE+f9s/Jh2eNNMHWYPqIdoehWxvsLatSQIfHLgWjf926Dz kzoRg1uBjtiYx0bQVyydzCuYH2BDlhEtvAWEEpebXg3p3n1sqvikITzriqvqkgWL hdt9PKBc0P1YEabOEWfGxqE= Received: (qmail 90270 invoked by alias); 23 Oct 2019 13:07:36 -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 90247 invoked by uid 89); 23 Oct 2019 13:07:36 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-21.5 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, SPF_PASS autolearn=ham version=3.3.1 spammy=arrives X-HELO: esa4.mentor.iphmx.com Received: from esa4.mentor.iphmx.com (HELO esa4.mentor.iphmx.com) (68.232.137.252) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 23 Oct 2019 13:07:34 +0000 IronPort-SDR: Zo651Il7exoWgCH35SC5EXmDlncf0vuGW39ZAWfFxisES9UaNn5eo5xWn8ZPAu+W0yqGL46tWw j9MMclYYwx701NuOSo1kkcQL72CRoEHl7fIiQeoSvDDN8xz5D17J0DrYKw2gNDtMPu1TdLNCfC IoFfknCQPIfTawTyjMsCGw0m3TprihCNK2vP9Xn6nl6jSe76nk7Q60VQ2O6rzzDR/47/gqWVLY VYgLXXWP55aeU6uGwNdUAHN5+DvgI7UOUD7z/IW8pA1zStxZJNrZE25D6R0jjbeT5R7a29c4mT xkU= Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 23 Oct 2019 05:07:33 -0800 IronPort-SDR: HqYtjG4n4fLjT3JjWbFye4K/n5gnhCsrZ0ICcV4XKPi8qvm2GosUNYDX3m5HAQWlHAXHwJdD77 1grPhoMHTdWrvnM82a9p70i8IkZwt1Ky3s3XFl/zYOM3qz3mRaGl87suGreHNq5BiDB0i+lKf+ lHEB6udr23du3VTq6WkQxkN5wM1lstSZ6EDaME5+gVlIhKbhaR8FdDCygm+zZJ8wvBmo/qgANP bmRfeAyBOIFmG74nMh02dgcSkUvyM/7TWc6wJkBdkXwgZ7Gz8kdE/2IdIRIJls813bU+xmTciU RXM= To: gcc-patches , fortran , Paul Richard Thomas From: Tobias Burnus Subject: [Patch, Fortran] PR91863 - fix call to bind(C) with array descriptor Message-ID: <9dc15d5a-5f80-a5fa-67a0-9d633f0e6923@codesourcery.com> Date: Wed, 23 Oct 2019 15:07:27 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.1.2 MIME-Version: 1.0 X-IsSubscribed: yes With the trunk, there are three issues: (a) With bind(C), the callee side handles deallocation with intent(out). This should produce the code:     if (cfi.0 != 0B)       {         __builtin_free (cfi.0);         cfi.0 = 0B;       } This fails as cfi.0 (of type 'void*') is dereferenced and *cfi.0 = 0B' (i.e. assignment of type 'void') causes the ICE. (b) With that fixed, one gets: sub (cfi.4); _gfortran_cfi_desc_to_gfc_desc (&a, &cfi.4); if (cfi.4 != 0B) __builtin_free (cfi.4); ... code using "a" ... That also won't shine as 'a.data' == 'cfi.4'; hence, one accesses already freed memory. I don't see whether freeing the cfi memory makes sense at all; as I didn't come up with a reason, I removed it for good. Those issues, I have solved. The third issue is now PR fortran/92189: (c) When allocating memory in a Fortran-written Bind(C) function, the shape/bounds changes are not propagated back to Fortran. Namely, "sub" lacks some _gfortran_gfc_desc_to_cfi_desc call at the end! The issue pops up, if you change 'dg-do compile' into 'dg-do run'. For using a C-written function, that's a non-issue. Hence, it makes sense to fix (a)+(b) of the bug separately. OK for the trunk and GCC 9? (At least the ICE is a regression.) Tobias PR fortran/91863 * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Don't free data memory as that's done on the Fortran side. (gfc_conv_procedure_call): Handle void* pointers from gfc_conv_gfc_desc_to_cfi_desc. PR fortran/91863 * gfortran.dg/bind-c-intent-out.f90: New. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 65238ff623d..7eba1bbd082 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5206,7 +5206,6 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) int attribute; int cfi_attribute; symbol_attribute attr = gfc_expr_attr (e); - stmtblock_t block; /* If this is a full array or a scalar, the allocatable and pointer attributes can be passed. Otherwise it is 'CFI_attribute_other'*/ @@ -5325,18 +5324,6 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) /* The CFI descriptor is passed to the bind_C procedure. */ parmse->expr = cfi_desc_ptr; - /* Free the CFI descriptor. */ - gfc_init_block (&block); - cond = fold_build2_loc (input_location, NE_EXPR, - logical_type_node, cfi_desc_ptr, - build_int_cst (TREE_TYPE (cfi_desc_ptr), 0)); - tmp = gfc_call_free (cfi_desc_ptr); - gfc_add_expr_to_block (&block, tmp); - tmp = build3_v (COND_EXPR, cond, - gfc_finish_block (&block), - build_empty_stmt (input_location)); - gfc_prepend_expr_to_block (&parmse->post, tmp); - /* Transfer values back to gfc descriptor. */ tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr); tmp = build_call_expr_loc (input_location, @@ -6250,8 +6237,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_add_expr_to_block (&se->pre, tmp); } - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + tmp = parmse.expr; + /* With bind(C), the actual argument is replaced by a bind-C + descriptor; in this case, the data component arrives here, + which shall not be dereferenced, but still freed and + nullified. */ + if (TREE_TYPE(tmp) != pvoid_type_node) + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) tmp = gfc_conv_descriptor_data_get (tmp); tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, diff --git a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 new file mode 100644 index 00000000000..493e546d45d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 @@ -0,0 +1,41 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/91863 +! +! Contributed by G. Steinmetz +! + +subroutine sub(x) bind(c) + implicit none (type, external) + integer, allocatable, intent(out) :: x(:) + + allocate(x(3:5)) + x(:) = [1, 2, 3] +end subroutine sub + + +program p + implicit none (type, external) + interface + subroutine sub(x) bind(c) + integer, allocatable, intent(out) :: x(:) + end + end interface + integer, allocatable :: a(:) + + call sub(a) + if (.not.allocated(a)) stop 1 + if (any(shape(a) /= [3])) stop 2 + if (lbound(a,1) /= 3 .or. ubound(a,1) /= 5) stop 3 + if (any(a /= [1, 2, 3])) stop 4 +end program p + +! "cfi" only appears in context of "a" -> bind-C descriptor +! the intent(out) implies freeing in the callee (!), hence the "free" +! It is the only 'free' as 'a' is part of the main program and, hence, implicitly has the SAVE attribute. +! The 'cfi = 0' appears before the call due to the deallocate and when preparing the C descriptor + +! { dg-final { scan-tree-dump-times "__builtin_free" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "cfi\\.\[0-9\]+ = 0B;" 2 "original" } }