From patchwork Tue Oct 29 09:09:23 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1185924 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-511953-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="Xa8IyYqf"; 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 472Ql92vkXz9sPK for ; Tue, 29 Oct 2019 20:09:41 +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=m3WNHxTHhBY06hU732vXu7kPe8DAla3VezEC8H1I8Rqd+nC8Om kmGD2Epz42zNBaNO1X89mvPiY0gbd1neatxIcOwD513oDCkvzQfVBf3Pmq7u5nze YMSYghJXW/k2/nitQWabJWCDA9/U8VfjCj1XZ18gEUdVakkoT/Nwb3ArA= 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=oynWfktqCxn7NlcC47vuR6JCPWY=; b=Xa8IyYqfIOArswcbzWxV jls5slz19vKeVcPrp4qxNY/KIqwzWk1Bzf6MBZ3X5IhUYPEF1TAdw5Zn+iduK1AO sTFacsaMVjsL46128I2Oj8Se/4NClbZroaijAtgY1BUF8Ye5v5G3gaMJnUA7+2lo 65qclH8Yh05Dn1qhSx2rRPQ= Received: (qmail 83217 invoked by alias); 29 Oct 2019 09:09:33 -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 83191 invoked by uid 89); 29 Oct 2019 09:09:32 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-20.9 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= X-HELO: esa3.mentor.iphmx.com Received: from esa3.mentor.iphmx.com (HELO esa3.mentor.iphmx.com) (68.232.137.180) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 29 Oct 2019 09:09:31 +0000 IronPort-SDR: k7xOQW5IEFquIkzKX6/2aS0JnvNbi0WzOyTPeILCYipjvq5a3BGhUmfHa6oRoFaZL43OLiPBJI kdXIgp3HyVdmMh+6ggB5W/OCP8UZlkLOi5co4RzrbtLfPHTdUhKJR4pLcapd7ayAdkIJKckKKB Ts4l6RpyIvfwYcLRGjrdepxcpmXNHMzDkPlZ1pLuC50l4+x1W5iRb6XZ5S1EpCwhcPSIcVsr57 yT27ZilazF3VwIcT0oIjjOzlEdpH9c59wfV3nt7n0TMBpUEMVsj9vNZjxXCvRaseCIHTpULu7B hDM= Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 29 Oct 2019 01:09:29 -0800 IronPort-SDR: wfkpg/mlcnLas6VXE+LOdbg6ReY9KumLS4i6eghQVHUojmmqy0sTNy3ciXWtUyHBv3dWIWQPtv hH/apjSex0vW0vYmi+FTbYe54+KvuEh84Rq464z9Xx8Lke8/wSK2TRqf7X6Vh1aIPwhqaeSRjq FLGL4uPrim7SSggljOyV9FMV4G+ZodfwL1JAIzJwQfiI2Teo7OeCnkY7viOlJB/rxoKH7xPHau LODqP7bfAR8n1Ak0HjEgjSKtYowvPdm4ox9DTdllKbOgjlVIKC7eDpoT/To7ivJj+pKju6A665 JNY= To: gcc-patches , fortran , Thomas Koenig From: Tobias Burnus Subject: [Patch][Fortran] PR 92208 don't use function-result dummy variable as actual argument Message-ID: <009d3b27-2b32-5ee7-3438-3c29ae2594e7@codesourcery.com> Date: Tue, 29 Oct 2019 10:09:23 +0100 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 For code like:    call foo(char_array=bar()) gfortran was using the symbol of the (hidden) result-string-length dummy argument of "bar" ("..__result") as (hidden) string-length actual argument when calling "foo". Naturally, the middle end was not amused and gave an ICE (with GCC 9 + 10). For the attached test case (cf. also PR), the LHS (se->string_length) already contained the expected string length (MAX_EXPR <(integer(kind=8)) D.4012, 0>). While the RHS (expr->ts.u.cl->backend_decl) contained the decl of "..__result". (I have to admit that I do not fully gasp the code, hence, I do not see whether there are other missing cases or whether there are corner cases where the patch causes wrong code.) OK for the trunk and GCC 9? Tobias PR fortran/92208 * trans-array.c (gfc_conv_array_parameter): Only copy string-length backend_decl if expression is not a function. PR fortran/92208 * gfortran.dg/pr92208.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 437892a6abf..2d85bf78c42 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8049,7 +8049,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, /* The components shall be deallocated before their containing entity. */ gfc_prepend_expr_to_block (&se->post, tmp); } - if (expr->ts.type == BT_CHARACTER) + if (expr->ts.type == BT_CHARACTER && expr->expr_type != EXPR_FUNCTION) se->string_length = expr->ts.u.cl->backend_decl; if (size) array_parameter_size (se->expr, expr, size); diff --git a/gcc/testsuite/gfortran.dg/pr92208.f90 b/gcc/testsuite/gfortran.dg/pr92208.f90 new file mode 100644 index 00000000000..9de7f4b24b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr92208.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! +! PR fortran/92208 +! +! Contributed by Nils Reiche +! +program stringtest + implicit none + integer, parameter :: noVars = 2 + +! print*, "varNames: ", createVarnames("var",noVars) + call function1(noVars,createVarnames("var",noVars),"path") + +contains + +function createVarnames(string,noVars) result(stringArray) + implicit none + character(len=*), intent(in) :: string + integer, intent(in) :: noVars + character(len=len_trim(string)+6), dimension(noVars) :: stringArray + integer :: i + do i=1,noVars + write(stringArray(i),'(a,i0)') string, i + enddo +end function createVarnames + +subroutine function1(noVars,varNames,path) + implicit none + integer, intent(in) :: noVars + character(len=*), intent(in) :: path + character(len=*), dimension(noVars) :: varNames + + if (path /= 'path') stop 1 + if (any(varNames /= ['var1', 'var2'])) stop 2 + !print*, "function1-path : ", trim(path) + !print*, "function1-varNames: ", varNames +end subroutine function1 + +end program stringtest