From patchwork Tue Oct 19 13:19:31 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 46394 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 947793857809 for ; Tue, 19 Oct 2021 13:20:09 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 718C7385801A; Tue, 19 Oct 2021 13:19:39 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 718C7385801A 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: yI2MEtElxw9uVTyf4akfgBBW4jwOSNpXvUcCWpzG13EY1QfOO2B9DZ1bqbwiahD3phQeBK1pQ+ 4OarlJHa64+4eh4GCu8iHF+EuZNLn+QJ31xM/xOeL1+ibd6edXc8+2F7X+guvQMo5o5hcHr1gc RXHXZB+TZdZgI8i6M51e4VjCRqJsDGTD2ncGYAXqaI80h7ts9lsVKGfPhDfs2+V6iDXs0VYpiF Shc7FT8i2B4/EvNn8FIJ62KVNJzGJN5eZDXwKhj9cD1/zMYmrjC6FYg+ygF88hw6X2gHWBAF2M p8MzaOf9jcZYhtNoqeRRusjB X-IronPort-AV: E=Sophos;i="5.87,163,1631606400"; d="diff'?scan'208";a="67226103" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 19 Oct 2021 05:19:39 -0800 IronPort-SDR: KahxPOpJ91nUP0EClBULj4kZ4HX51G8tKrrNtAnLT5/R1xZihkPDCfNrl74MXuAxnmyHdXSSOv vb+CmhPQ++jJmw4o6AE6QJhCmTOOZpIE/xgiWkyZZuCT8EcfX5For6KAQW38iR4XLsNF58f1sh APJ63fw1rln5gu2wqxg2kfxzAKFRSgaqTKQTQ5KyqedWyokcWRnkNHNDJYGnGkLbVCYqvoia1/ ebji1BsnU5TIfVxE8hxmGqEcjcsmZv43kjY0SoR/bZpg43tpTxdRn8U5+dmcGFhTOT+ziSikig viI= Message-ID: <4492c2ed-8b72-32eb-e175-4e8c8e1afb81@codesourcery.com> Date: Tue, 19 Oct 2021 15:19:31 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.2.0 Content-Language: en-US To: fortran , gcc-patches From: Tobias Burnus Subject: [Patch, committed] Fortran: Fix "str" to scalar descriptor conversion [PR92482] X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-09.mgc.mentorg.com (139.181.222.9) 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" Here, the problem is that the param.expr was: &"abc" -> type: "char*" as that's an ADDR_EXPR, the previous code dereferrenced it: *&"abc" -> type *(char*) but that's the type 'char'. Thus, at the end, the result was scalar = 'a' -> type char instead of scalar "abc" -> type char array of size 3 Solution: Do what the comment does – remove the ADDR_EXPR insead of dereferrencing the result. Build + regtested on x86_64-gnu-linux + installed as r12-4505-g6920d5a1a2834e9c62d441b8f4c6186b01107d13 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 6920d5a1a2834e9c62d441b8f4c6186b01107d13 Author: Tobias Burnus Date: Tue Oct 19 15:16:01 2021 +0200 Fortran: Fix "str" to scalar descriptor conversion [PR92482] PR fortran/92482 gcc/fortran/ChangeLog: * trans-expr.c (gfc_conv_procedure_call): Use TREE_OPERAND not build_fold_indirect_ref_loc to undo an ADDR_EXPR. gcc/testsuite/ChangeLog: * gfortran.dg/bind-c-char-descr.f90: Remove xfail; extend a bit. --- gcc/fortran/trans-expr.c | 2 +- gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 | 57 ++++++++++++++++--------- 2 files changed, 39 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 01389373065..29697e69e75 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6640,7 +6640,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { tmp = parmse.expr; if (TREE_CODE (tmp) == ADDR_EXPR) - tmp = build_fold_indirect_ref_loc (input_location, tmp); + tmp = TREE_OPERAND (tmp, 0); parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp, fsym->attr); parmse.expr = gfc_build_addr_expr (NULL_TREE, diff --git a/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 index 3b01ad3b63d..8829fd1f71b 100644 --- a/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 +++ b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 @@ -2,7 +2,6 @@ ! ! Contributed by José Rui Faustino de Sousa ! -! Note the xfail issue below for 'strg_print_2("abc") program strp_p @@ -24,13 +23,18 @@ program strp_p if (len(str) /= 3 .or. str /= "abc") stop 1 if (len(strp_1) /= 3 .or. strp_1 /= "abc") stop 2 if (len(strp_2) /= 3 .or. strp_2 /= "abc") stop 3 - call strg_print_0("abc") ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_0(str) ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_0(strp_1) ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_0(strp_2) ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_1(strp_1) ! Not yet supported + call strg_print_0("abc") + call strg_print_0(str) + call strg_print_0(strp_1) + call strg_print_0(strp_2) + call strg_print_0_c("abc") + call strg_print_0_c(str) + call strg_print_0_c(strp_1) + call strg_print_0_c(strp_2) + call strg_print_1(strp_1) + call strg_print_1_c(strp_1) - call strg_print_2("abc", xfail=.true.) + call strg_print_2("abc") call strg_print_2(str) call strg_print_2(strp_1) call strg_print_2(strp_2) @@ -42,14 +46,21 @@ program strp_p contains - subroutine strg_print_0(this) bind(c) ! Error (10.0.0 20191106) or warning (9.1.0) issued with bind(c) + subroutine strg_print_0 (this) character(len=*, kind=c_char), target, intent(in) :: this if (len (this) /= 3) stop 10 if (this /= "abc") stop 11 end subroutine strg_print_0 + + subroutine strg_print_0_c (this) bind(c) + character(len=*, kind=c_char), target, intent(in) :: this + + if (len (this) /= 3) stop 10 + if (this /= "abc") stop 11 + end subroutine strg_print_0_c - subroutine strg_print_1(this) bind(c) ! Not yet supported with bind(c) + subroutine strg_print_1 (this) bind(c) character(len=:, kind=c_char), pointer, intent(in) :: this character(len=:), pointer :: strn @@ -63,26 +74,34 @@ contains if (this /= "abc") stop 25 end if end subroutine strg_print_1 + + subroutine strg_print_1_c (this) bind(c) + character(len=:, kind=c_char), pointer, intent(in) :: this + character(len=:), pointer :: strn + + if (.not. associated (this)) stop 20 + if (len (this) /= 3) stop 21 + if (this /= "abc") stop 22 + strn => this + if (.not. associated (strn)) stop 23 + if(associated(strn))then + if (len (this) /= 3) stop 24 + if (this /= "abc") stop 25 + end if + end subroutine strg_print_1_c - subroutine strg_print_2(this, xfail) + subroutine strg_print_2(this) use, intrinsic :: iso_c_binding, only: & c_loc, c_f_pointer type(*), target, intent(in) :: this(..) - logical, optional, value :: xfail character(len=l), pointer :: strn call c_f_pointer(c_loc(this), strn) if (.not. associated (strn)) stop 30 - if(associated(strn))then + if (associated(strn)) then if (len (strn) /= 3) stop 31 - if (strn /= "abc") then - if (present (xfail)) then - print *, 'INVALID STRING - EXPECTED "abc" / PR47225' - else - stop 32 - end if - end if + if (strn /= "abc") stop 32 end if end subroutine strg_print_2