From patchwork Wed Aug 26 16:29:40 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1352033 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=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Received: from 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 RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4BcBCk0hLJz9sT6 for ; Thu, 27 Aug 2020 02:29:52 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BEF89386F453; Wed, 26 Aug 2020 16:29:50 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 57205386EC41; Wed, 26 Aug 2020 16:29:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 57205386EC41 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: Mratcj1kSfF2RErag+NO6l96qE8OU73Ubq8FVMWo7fTAzIxbbDOEeagNgCPLLpgb3B/mSCv7t+ iiM5UzX0N/uzcFsooEygWMFnx4Sz0XOSVP+q833Ozcgzw4yOy7hE7Dds6IPzIy6fPuodvm5jRO r/sTkknLCuLTbkcpNO/VDZhcLRBXjpkK/RBsyVoCpDhK2n10jEiz8vlD8ICciTLSkYUYvHWPR9 q9IiYl9D00v/dAc1q8VwPcpjPGBvtZTUmSHT4ZKmUI+JANvsXznTV0ritntCIBr6IsDlxtz9+7 cGQ= X-IronPort-AV: E=Sophos;i="5.76,356,1592899200"; d="diff'?scan'208";a="54469211" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa1.mentor.iphmx.com with ESMTP; 26 Aug 2020 08:29:46 -0800 IronPort-SDR: HnVhzTVn5U9vh7t5bTSzcj2j/NWXb3U2a6ErMqAY/dDii/GqMYRaUSYhaoOlPzeSO1uC7aDXbG TDAVtRZTZmJRxrhL4hSmHcIn3XATURs1Cvv7PuNuiSn22O5ILFEC5sesXWB0SRnkxRE50yXpZm 6kK6zH9wi6cMQUVlQ1vJI298/N0vJQuzvII02c27WHiCrJXSb/viGXY/u6S9N0iZOzqfy/N38c fTnNSWFrkzs7itmL2XdUP4+qvdDRd1ZxOK6FaA4DhvpNzvChsSJ6eWbML7AvGvBOpKl1VW3Jm7 4uE= To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch] Fortran: Fix absent-optional handling for nondescriptor arrays (PR94672) Message-ID: <5080fb8d-4f12-73ec-0aa7-c01ebf25b60b@codesourcery.com> Date: Wed, 26 Aug 2020 18:29:40 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.11.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: SVR-IES-MBX-07.mgc.mentorg.com (139.181.222.7) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-12.4 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.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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@gcc.gnu.org Sender: "Gcc-patches" This fixes an issue caused by the patch for PR 94672, which affects both GCC 10 and GCC 11. Only 'sVal' of 'subroutine foo' was affected, the rest is only a crosscheck that it worked for those code paths. (I did check against the dump – which looks fine. I could add dump tests as well. The 'foo' test was failing with 'stop 5' (absent argument) at runtime before the patch; the report was for the 'stop 4' case, which is probably harder to trigger as run-time fail as the stack memory is likely zero-initialized. → -fdump-tree-original scan test useful?) OK for mainline and GCC 10? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter Fortran: Fix absent-optional handling for nondescriptor arrays (PR94672) gcc/fortran/ChangeLog: PR fortran/94672 * trans-array.c (gfc_trans_g77_array): Check against the parm decl and set the nonparm decl used for the is-present check to NULL if absent. gcc/testsuite/ChangeLog: PR fortran/94672 * gfortran.dg/optional_assumed_charlen_2.f90: New test. gcc/fortran/trans-array.c | 10 ++++- .../gfortran.dg/optional_assumed_charlen_2.f90 | 48 ++++++++++++++++++++++ 2 files changed, 56 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0e3495d59cc..6566c47d4ae 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6472,8 +6472,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block) if (sym->attr.optional || sym->attr.not_always_present) { - tmp = gfc_conv_expr_present (sym); - stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location)); + tree nullify; + if (TREE_CODE (parm) != PARM_DECL) + nullify = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, + parm, null_pointer_node); + else + nullify = build_empty_stmt (input_location); + tmp = gfc_conv_expr_present (sym, true); + stmt = build3_v (COND_EXPR, tmp, stmt, nullify); } gfc_add_init_cleanup (block, stmt, NULL_TREE); diff --git a/gcc/testsuite/gfortran.dg/optional_assumed_charlen_2.f90 b/gcc/testsuite/gfortran.dg/optional_assumed_charlen_2.f90 new file mode 100644 index 00000000000..fa8cfd79038 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/optional_assumed_charlen_2.f90 @@ -0,0 +1,48 @@ +! { dg-do run } +! PR fortran/94672 +! +! Contributed by Tomáš Trnka +! +module m + implicit none (type,external) + type t + integer :: i = 5 + end type t +contains +subroutine bar(x, y, z, n) + integer, value :: n + type(t), intent(out), optional :: x(:), y(n), z(:) + allocatable :: z +end subroutine bar + +subroutine foo (n, nFound, sVal) + integer, value :: n + integer, intent(out) :: nFound + character(*), optional, intent(out) :: sVal(n) + + nFound = 0 + + if (present(sVal)) then + nFound = nFound + 1 + end if +end subroutine +end + +use m +implicit none (type,external) +type(t) :: a(7), b(7), c(:) +allocatable :: c +integer :: nn, nf +character(len=4) :: str + +allocate(c(7)) +call bar(a,b,c,7) +if (any(a(:)%i /= 5)) stop 1 +if (any(b(:)%i /= 5)) stop 2 +if (allocated(c)) stop 3 + +call foo(7, nf, str) +if (nf /= 1) stop 4 +call foo(7, nf) +if (nf /= 0) stop 5 +end