From patchwork Tue Oct 26 09:04:18 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 46652 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3924D3858D3C for ; Tue, 26 Oct 2021 09:04:50 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 3E1603858D3C; Tue, 26 Oct 2021 09:04:25 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 3E1603858D3C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: +njze1vAly5EFNLnudCLp4X6vll3WMcHMJDggyYvDqaIETrZHjrNEtN94S0h3xd2lTJuQINrK2 vDe/ZYAfEDzmoQQ27/tyAWkOWOeJNe13qfrMRfmichC2K/Qd3ZLkzWqZCT9tmMfHsGZCw3KeM1 GB7h9GVaUKJzV1EnhgJBTWAyQL8Up4GanIik6V3vbGZ9J3aul71ff8IVuiWK8jcKGGQOtmvz3P oDnBF7w/EK5d72NtgTRMErBwuumwYiSkzHFuIdP96dY9gWVxAW1nVt5VuF7A4yMT3SZiLLhpHU A/lsobx690/Srm6f09yNI5t+ X-IronPort-AV: E=Sophos;i="5.87,182,1631606400"; d="diff'?scan'208";a="67627780" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 26 Oct 2021 01:04:23 -0800 IronPort-SDR: RUFYhxp5WfevOmA7XFW9SqxfHc1+qdJjvDu3DRJsr7XMtvti+cp5v/D+3Q1haGxb7v3np4rzXo UNqHl/Q9XaD1PQ7wytTTUl0l5X3+yBgZOFF/ObAY/ZIF9JGpEAAZJv655VgKoBTpP6pOeVShmO n/GpzU5WQc2aG2e84zLQG+w5GxnTb+QraGLRZ74pTPUEOurl8F7QK3+F5s7NiizH1TQwSw99UU 0bBjWkUwQKuH/qWnM9hp6eJlK7FTrsTlZkJBIijT06lLS/Frkd/qvN8nVanrA+THpi8JyS3UbZ 4OU= Message-ID: <14c3ac17-0bb1-f36c-5d3c-500a1290ffee@codesourcery.com> Date: Tue, 26 Oct 2021 11:04:18 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.2.1 Content-Language: en-US To: gcc-patches , fortran From: Tobias Burnus Subject: [committed] Fortran: Fix character(len=cst) dummies with bind(C) [PR102885] (erratum: should be: 'len=noncst') X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-02.mgc.mentorg.com (139.181.222.2) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" I forgot to handle len= correctly. This patch does the same as for non-BIND(C). In the latter case, the call is: gfc_generate_function_code → gfc_trans_deferred_vars → gfc_trans_deferred_array and that function has if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.u.cl->backend_decl)) { gfc_conv_string_length (sym->ts.u.cl, NULL, &init); gfc_trans_vla_type_sizes (sym, &init); } Expect a déjà vu if you read the attached patch ... Thanks to Dominique for testing with -flto and finding this issue and to Richard for helping me to understand what goes wrong. Committed as obvious as r12-4703. Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 commit a31a3d0421f0cf1f7eefacfec8cbf37e7f91600d Author: Tobias Burnus Date: Tue Oct 26 10:53:53 2021 +0200 Fortran: Fix character(len=cst) dummies with bind(C) [PR102885] PR fortran/102885 gcc/fortran/ChangeLog: * trans-decl.c (gfc_conv_cfi_to_gfc): Properly handle nonconstant character lenghts. gcc/testsuite/ChangeLog: * gfortran.dg/lto/bind-c-char_0.f90: New test. --- gcc/fortran/trans-decl.c | 7 ++++ gcc/testsuite/gfortran.dg/lto/bind-c-char_0.f90 | 49 +++++++++++++++++++++++++ 2 files changed, 56 insertions(+) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index fe5511b5285..49ba9060eae 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -6837,6 +6837,13 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, gfc_add_modify (&block, sym->ts.u.cl->backend_decl, tmp); } + if (sym->ts.type == BT_CHARACTER + && !INTEGER_CST_P (sym->ts.u.cl->backend_decl)) + { + gfc_conv_string_length (sym->ts.u.cl, NULL, init); + gfc_trans_vla_type_sizes (sym, init); + } + /* gfc->data = cfi->base_addr - or for scalars: gfc = cfi->base_addr. assumed-size/explicit-size arrays end up here for character(len=*) only. */ diff --git a/gcc/testsuite/gfortran.dg/lto/bind-c-char_0.f90 b/gcc/testsuite/gfortran.dg/lto/bind-c-char_0.f90 new file mode 100644 index 00000000000..48b495b1d29 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind-c-char_0.f90 @@ -0,0 +1,49 @@ +! { dg-lto-do link } +! { dg-lto-options {{ -O0 -flto }} } +! +! PR fortran/102885 + +module m + use iso_c_binding, only: c_char + implicit none (type, external) + +contains + +! Assumed-shape array, nonallocatable/nonpointer + +subroutine ar3 (xn, n) bind(C) + integer :: n + character(len=n) :: xn(..) + if (size(xn) /= 6) stop + if (len(xn) /= 5) stop + select rank(xn) + rank(1) + xn = ['FDGhf', & + 'hdrhg', & + 'fDgFl', & + 'DFHs3', & + '4a54G', & + 'hSs6k'] + rank default + stop + end select +end + +end + +program main + use m + implicit none (type, external) + character(kind=c_char, len=5) :: str5a6(6) + + ! assumed rank - with array descriptor + + str5a6 = ['DDGhf', & + 'hdrh$', & + 'fDGSl', & + 'DFHs3', & + '43grG', & + 'hFG$k'] + call ar3 (str5a6, 5) + +end