From patchwork Fri Mar 15 19:32:50 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1912682 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4TxDv01xV2z1yWn for ; Sat, 16 Mar 2024 06:33:32 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 46F203860C39 for ; Fri, 15 Mar 2024 19:33:30 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from ciao.gmane.io (ciao.gmane.io [116.202.254.214]) by sourceware.org (Postfix) with ESMTPS id 38E26385E446 for ; Fri, 15 Mar 2024 19:33:01 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 38E26385E446 Authentication-Results: sourceware.org; dmarc=fail (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=m.gmane-mx.org ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 38E26385E446 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=116.202.254.214 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1710531187; cv=none; b=HCXf+MBa7zGR5y4IP7SRVVGdzJdeBmKST8AsjowupWHOSHuVcTcKBOvwEj26ZNeT9b39UKN5CZrRTeNgvj+ugrE2MTalf0lJfjTgCh//xYGPfsvt5iV9l7C55VEmZ77HK2hnHksRBE48OUW8AYGNZcexDY6fJrob85We1+7d8pg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1710531187; c=relaxed/simple; bh=BiNXi3CkOxUAr58XtDV60EFqQVcCwdLx/5ywrs0/BHc=; h=To:From:Subject:Date:Message-ID:Mime-Version; b=kakLbDjZfEUSmiAd0fcZRx4DPnmHwhTqdxYoMd1+j54g4rEVJDe9DodsZHMMX6NV/91ZwIXP/74N01YqS1NiJGGnBQAMVIwDnYtKd7QjoHYFuehYgXHUPhKIcdTtbzPZCMf0MeXYdvxkDGFsI/s3g9LQCizCM3csrYi5sDfGw5k= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from list by ciao.gmane.io with local (Exim 4.92) (envelope-from ) id 1rlDIZ-0008A3-I7 for gcc-patches@gcc.gnu.org; Fri, 15 Mar 2024 20:32:59 +0100 X-Injected-Via-Gmane: http://gmane.org/ To: gcc-patches@gcc.gnu.org From: Harald Anlauf Subject: [PATCH, v2] Fortran: fix for absent array argument passed to optional dummy [PR101135] Date: Fri, 15 Mar 2024 20:32:50 +0100 Message-ID: References: <3fd50892-dbef-d43a-8efe-148a8ffa94a9@orange.fr> <24718b24-981a-730c-4cd3-b6f4727797a0@gmx.de> Mime-Version: 1.0 User-Agent: Mozilla Thunderbird Content-Language: en-US In-Reply-To: <24718b24-981a-730c-4cd3-b6f4727797a0@gmx.de> Cc: fortran@gcc.gnu.org X-Spam-Status: No, score=-9.1 required=5.0 tests=BAYES_00, FREEMAIL_FORGED_FROMDOMAIN, FREEMAIL_FROM, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Dear all, as there has been some good progress in the handling of optional dummy arguments, I looked again at this PR and a patch for it that I withdrew as it turned out incomplete. It turned out that it now needs only a minor adjustment for optional dummy arguments of procedures with bind(c) attribute so that ubsan checking does not trigger. Along this way I extended the previous testcase to exercise to some extent combinations of bind(c) and non-bind(c) procedures and found one failure (since at least gcc-9) that is genuine: passing a missing optional from a bind(c) procedure to an assumed-rank dummy, see PR114355. The corresponding test is commented in the testcase. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald On 2/6/22 22:04, Harald Anlauf wrote: > Hi Mikael, > > Am 04.02.22 um 11:45 schrieb Mikael Morin: >> Hello, >> >> Le 29/01/2022 à 22:41, Harald Anlauf via Fortran a écrit : >>> The least invasive change - already pointed out by the reporter - is >>> to check the presence of the argument before dereferencing the data >>> pointer after the offset calculation.  This requires adjusting the >>> checking pattern for gfortran.dg/missing_optional_dummy_6a.f90. >>> >>> Regtesting reminded me that procedures with bind(c) attribute are doing >>> their own stuff, which is why they need to be excluded here, otherwise >>> testcase bind-c-contiguous-4.f90 would regress on the expected output. > > only after submitting the patch I figured that the patch is incomplete. > > When we have a call chain of procedures with and without bind(c), > there are still cases left where the failure with the sanitizer > is not fixed.  Just add "bind(c)" to subroutine test_wrapper only > in the original PR. > > I have added a corresponding comment in the PR. > >>> There is a potential alternative solution which I did not pursue, as I >>> think it is more invasive, but also that I didn't succeed to implement: >>> A non-present dummy array argument should not need to get its descriptor >>> set up.  Pursuing this is probably not the right thing to do during the >>> current stage of development and could be implemented later.  If >>> somebody >>> believes this is important, feel free to open a PR for this. >>> >> I have an other (equally unimportant) concern that it may create an >> unnecessary conditional when passing a subobject of an optional >> argument.  In that case we can assume that the optional is present. >> It’s not a correctness issue, so let’s not bother at this stage. > > Judging from the dump tree of the cases I looked at I did not see > anything that would pose a problem to the optimizer. > >>> Regtested on x86_64-pc-linux-gnu.  OK for mainline? >>> >> OK. > > Given my latest observations I'd rather withdraw the current version of > the patch and rethink.  I also did not see an issue with bind(c) > procedures calling alikes. > > It would help if one would not only know the properties of the actual > argument, but also of the formal one, which is not available at that > point in the code.  I'll have another look and resubmit. > >> Thanks. >> > > Thanks for the review! > > Harald > From b3079a82a220477704f8156207239e4af4103ea9 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Fri, 15 Mar 2024 20:14:07 +0100 Subject: [PATCH] Fortran: fix for absent array argument passed to optional dummy [PR101135] gcc/fortran/ChangeLog: PR fortran/101135 * trans-array.cc (gfc_get_dataptr_offset): Check for optional arguments being present before dereferencing data pointer. gcc/testsuite/ChangeLog: PR fortran/101135 * gfortran.dg/missing_optional_dummy_6a.f90: Adjust diagnostic pattern. * gfortran.dg/ubsan/missing_optional_dummy_8.f90: New test. --- gcc/fortran/trans-array.cc | 11 ++ .../gfortran.dg/missing_optional_dummy_6a.f90 | 2 +- .../ubsan/missing_optional_dummy_8.f90 | 108 ++++++++++++++++++ 3 files changed, 120 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/ubsan/missing_optional_dummy_8.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 3673fa40720..a7717a8107e 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -7526,6 +7526,17 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, /* Set the target data pointer. */ offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp); + + /* Check for optional dummy argument being present. Arguments of BIND(C) + procedures are excepted here since they are handled differently. */ + if (expr->expr_type == EXPR_VARIABLE + && expr->symtree->n.sym->attr.dummy + && expr->symtree->n.sym->attr.optional + && !is_CFI_desc (NULL, expr)) + offset = build3_loc (input_location, COND_EXPR, TREE_TYPE (offset), + gfc_conv_expr_present (expr->symtree->n.sym), offset, + fold_convert (TREE_TYPE (offset), gfc_index_zero_node)); + gfc_conv_descriptor_data_set (block, parm, offset); } diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 index c6a79059a91..b5e1726d74d 100644 --- a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 +++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 @@ -49,7 +49,7 @@ end program test ! { dg-final { scan-tree-dump-times "scalar2 \\(.* slr1" 1 "original" } } -! { dg-final { scan-tree-dump-times "= es1 != 0B" 1 "original" } } +! { dg-final { scan-tree-dump-times "= es1 != 0B" 2 "original" } } ! { dg-final { scan-tree-dump-times "assumed_shape2 \\(es1" 0 "original" } } ! { dg-final { scan-tree-dump-times "explicit_shape2 \\(es1" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/ubsan/missing_optional_dummy_8.f90 b/gcc/testsuite/gfortran.dg/ubsan/missing_optional_dummy_8.f90 new file mode 100644 index 00000000000..fd3914934aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ubsan/missing_optional_dummy_8.f90 @@ -0,0 +1,108 @@ +! { dg-do run } +! { dg-additional-options "-fdump-tree-original -fsanitize=undefined" } +! +! PR fortran/101135 - Load of null pointer when passing absent +! assumed-shape array argument for an optional dummy argument +! +! Based on testcase by Marcel Jacobse + +program main + implicit none + character(len=3) :: a(6) = ['abc', 'def', 'ghi', 'jlm', 'nop', 'qrs'] + call as () + call as (a(::2)) + call as_c () + call as_c (a(2::2)) + call test_wrapper + call test_wrapper_c + call test_ar_wrapper + call test_ar_wrapper_c +contains + subroutine as (xx) + character(len=*), optional, intent(in) :: xx(*) + if (.not. present (xx)) return + print *, xx(1:3) + end subroutine as + + subroutine as_c (zz) bind(c) + character(len=*), optional, intent(in) :: zz(*) + if (.not. present (zz)) return + print *, zz(1:3) + end subroutine as_c + + subroutine test_wrapper (x) + real, dimension(1), intent(out), optional :: x + call test (x) + call test1 (x) + call test_c (x) + call test1_c (x) + end subroutine test_wrapper + + subroutine test_wrapper_c (w) bind(c) + real, dimension(1), intent(out), optional :: w + call test (w) + call test1 (w) + call test_c (w) + call test1_c (w) + end subroutine test_wrapper_c + + subroutine test (y) + real, dimension(:), intent(out), optional :: y + if (present (y)) y=0. + end subroutine test + + subroutine test_c (y) bind(c) + real, dimension(:), intent(out), optional :: y + if (present (y)) y=0. + end subroutine test_c + + subroutine test1 (y) + real, dimension(1), intent(out), optional :: y + if (present (y)) y=0. + end subroutine test1 + + subroutine test1_c (y) bind(c) + real, dimension(1), intent(out), optional :: y + if (present (y)) y=0. + end subroutine test1_c + + subroutine test_ar_wrapper (p, q, r) + real, intent(out), optional :: p + real, dimension(1), intent(out), optional :: q + real, dimension(:), intent(out), optional :: r + call test_ar (p) + call test_ar (q) + call test_ar (r) + call test_ar_c (p) + call test_ar_c (q) + call test_ar_c (r) + end subroutine test_ar_wrapper + + subroutine test_ar_wrapper_c (u, v, s) bind(c) + real, intent(out), optional :: u + real, dimension(1), intent(out), optional :: v + real, dimension(:), intent(out), optional :: s + call test_ar (u) + call test_ar (v) +! call test_ar (s) ! Disabled due to runtime segfault, see pr114355 + call test_ar_c (u) + call test_ar_c (v) + call test_ar_c (s) + end subroutine test_ar_wrapper_c + + subroutine test_ar (z) + real, dimension(..), intent(out), optional :: z + end subroutine test_ar + + subroutine test_ar_c (z) bind(c) + real, dimension(..), intent(out), optional :: z + end subroutine test_ar_c +end program + +! { dg-final { scan-tree-dump-times "data = v != 0B " 2 "original" } } +! { dg-final { scan-tree-dump-times "data = w != 0B " 2 "original" } } +! { dg-final { scan-tree-dump-times "data = q != 0B " 2 "original" } } +! { dg-final { scan-tree-dump-times "data = x != 0B " 2 "original" } } +! { dg-final { scan-tree-dump-times "data = xx.0 != 0B " 1 "original" } } +! { dg-output " abcghinop(\n|\r\n|\r)" }" +! { dg-output " defjlmqrs(\n|\r\n|\r)" }" -- 2.35.3