From patchwork Sun Jan 2 18:32:17 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 49454 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 C18883858027 for ; Sun, 2 Jan 2022 18:32:52 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 60DAB3858C27; Sun, 2 Jan 2022 18:32:26 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 60DAB3858C27 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: vy/8w8av82uupjthaCL9nrbRAkkOKp46AYAYQphaZSJlnNr5vnRmU15EzNo+lVTxjc74YN2ohW t8+3x+IMdAP2ZiWG6buj/xOpkru9vsXtwXHzFhtrp1kfWEd5FwM2EJpdM/gemwG2EzQWUmFcgR MONv9Ty84kQbG0PNNyzT2QyH254BxJN4KsSYXl6c+F82prczUafui67rWuk0Ze3OJThUf7CxV5 1niMzKbyulmsZZ8Ht4dHZ1fgyXmTd45rTu2BfKgNo2AVJEXVJCIOrvvJdMzGHUjsx24xL7twgk GSTyGWgeYc2EhxyEQgC3DjVM X-IronPort-AV: E=Sophos;i="5.88,256,1635235200"; d="scan'208";a="70304861" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa4.mentor.iphmx.com with ESMTP; 02 Jan 2022 10:32:24 -0800 IronPort-SDR: wtD2WU8HX8Jo6cUCrZj0DzoKi5HqhsceNhWjEnC04zO/TELOtHmsT1fyAZb/vA263+ZQj6aoaE W7q5kkXtBowEiv4gp1L0Lidv43pzYZZoKsQ1Bpgl59HKKahho+UQEQsf/5LZyhsTJFzsPXzeM1 fP1pMGAYW4fAw3Ywb0zW8s/3BBcVffegZr0OK9U2mGlp/vcgQWGvVXnEXqn6GQ4Z0emKQe9Sr9 2Eg5XFLAkgwZNY9VSvySlJDvov/KIdImynkiDx5Rm6XI7faz6INfw5e+7ts9BQDCWepwiHY2UM Pxw= To: "fortran@gcc.gnu.org" From: Sandra Loosemore Subject: [PATCH] Fortran: fix PR103390, ICE in gimplification Message-ID: <8f3ff38c-5469-9811-3466-b12ad294df09@codesourcery.com> Date: Sun, 2 Jan 2022 11:32:17 -0700 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.14.0 MIME-Version: 1.0 Content-Language: en-US X-ClientProxiedBy: svr-orw-mbx-12.mgc.mentorg.com (147.34.90.212) To svr-orw-mbx-03.mgc.mentorg.com (147.34.90.203) X-Spam-Status: No, score=-9.2 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_STOCKGEN, 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: , Cc: Tobias Burnus , "gcc-patches@gcc.gnu.org" Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch is for PR103390. For background on this issue, the Fortran standard requires that, when passing a non-contiguous array from Fortran to a BIND(C) function with the CONTIGUOUS attribute on the corresponding dummy argument, the compiler has to arrange for it to be copied to/from a contiguous temporary. The ICE was happening because the front end was attempting to copy out to an array-valued expression that isn't an lvalue, and producing invalid code. I poked around at several related examples (included as test cases in the patch) and realized that it should not be doing any copying at all here, since the expression result already was being put in a contiguous temporary. And, besides the invalid code on copy-out, in some cases it was generating multiple copies of the code to compute the expression on copy-in. :-S Both parts of the patch seem to be necessary to fix all the test cases. Tobias pointed me in this direction when I discussed it with him a few weeks ago so I hope I got it right. OK to check in? It regression-tests fine on x86_64. -Sandra commit 3a5e4f3a14b4265ee6f92dd724cbae9103d38d4b Author: Sandra Loosemore Date: Wed Dec 29 16:44:14 2021 -0800 Fortran: Fix array copy-in/copy-out for BIND(C) functions [PR103390] The Fortran front end was generating invalid code for the array copy-out after a call to a BIND(C) function for a dummy with the CONTIGUOUS attribute when the actual argument was a call to the SHAPE intrinsic or other array expressions that are not lvalues. It was also generating code to evaluate the argument expression multiple times on copy-in. This patch teaches it to recognize that a copy is not needed in these cases. 2022-01-02 Sandra Loosemore PR fortran/103390 gcc/fortran/ * expr.c (gfc_is_simply_contiguous): Make it smarter about function calls. * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Do not generate copy loops for array expressions that are not "variables" (lvalues). gcc/testsuite/ * gfortran.dg/c-interop/pr103390-1.f90: New. * gfortran.dg/c-interop/pr103390-2.f90: New. * gfortran.dg/c-interop/pr103390-3.f90: New. * gfortran.dg/c-interop/pr103390-4.f90: New. * gfortran.dg/c-interop/pr103390-6.f90: New. * gfortran.dg/c-interop/pr103390-7.f90: New. * gfortran.dg/c-interop/pr103390-8.f90: New. * gfortran.dg/c-interop/pr103390-9.f90: New. diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c1258e0..a0129a3 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -5883,8 +5883,16 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) if (expr->expr_type == EXPR_FUNCTION) { - if (expr->value.function.esym) - return expr->value.function.esym->result->attr.contiguous; + if (expr->value.function.isym) + /* TRANPOSE is the only intrinsic that may return a + non-contiguous array. It's treated as a special case in + gfc_conv_expr_descriptor too. */ + return (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE); + else if (expr->value.function.esym) + /* Only a pointer to an array without the contiguous attribute + can be non-contiguous as a result value. */ + return (expr->value.function.esym->result->attr.contiguous + || !expr->value.function.esym->result->attr.pointer); else { /* Type-bound procedures. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 80c669f..10e1e37 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5536,13 +5536,17 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) { /* If the actual argument can be noncontiguous, copy-in/out is required, if the dummy has either the CONTIGUOUS attribute or is an assumed- - length assumed-length/assumed-size CHARACTER array. */ + length assumed-length/assumed-size CHARACTER array. This only + applies if the actual argument is a "variable"; if it's some + non-lvalue expression, we are going to evaluate it to a + temporary below anyway. */ se.force_no_tmp = 1; if ((fsym->attr.contiguous || (fsym->ts.type == BT_CHARACTER && !fsym->ts.u.cl->length && (fsym->as->type == AS_ASSUMED_SIZE || fsym->as->type == AS_EXPLICIT))) - && !gfc_is_simply_contiguous (e, false, true)) + && !gfc_is_simply_contiguous (e, false, true) + && gfc_expr_is_variable (e)) { bool optional = fsym->attr.optional; fsym->attr.optional = 0; @@ -6841,6 +6845,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, fsym->attr.pointer); } else + /* This is where we introduce a temporary to store the + result of a non-lvalue array expression. */ gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym, sym->name, NULL); diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-1.f90 new file mode 100644 index 0000000..804b2dd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-1.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! This program used to ICE in gimplification on the call to S, because it +! was trying to copy out the array after the call to something that wasn't +! an lvalue. + +program p + integer, pointer :: z(:) + integer, target :: x(3) = [1, 2, 3] + z => x + call s(shape(z)) +contains + subroutine s(x) bind(c) + integer, contiguous :: x(:) + end +end + +! It should not emit any copy loops, just the loop for inlining SHAPE. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 1 "original" } } + +! It should not emit code to check the contiguous property. +! { dg-final { scan-tree-dump-times "contiguous\\.\[0-9\]+" 0 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-2.f90 new file mode 100644 index 0000000..771d81d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-2.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of transpose result are +! still generated after fixing pr103390, and that it does not ICE. + +program p + integer, pointer :: z(:,:) + integer, target :: x(3,3) = reshape ([1, 2, 3, 4, 5, 6, 7, 8, 9], shape(x)) + z => x + call s(transpose(z)) +contains + subroutine s(x) bind(c) + integer, contiguous :: x(:,:) + end +end + +! Expect 2 nested copy loops both before and after the call to S. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 4 "original" } } + diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-3.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-3.f90 new file mode 100644 index 0000000..d3e0826 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-3.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of the result of a function +! that returns a non-pointer array are generated properly after fixing +! pr103390, and that it does not ICE. In this case no copying is required. + +program p + integer, pointer :: z(:) + integer, target :: x(3) = [1, 2, 3] + z => x + call s(i(z)) +contains + function i(x) + integer :: i(3) + integer, pointer :: x(:) + i = x + end + subroutine s(x) bind(c) + integer, contiguous :: x(:) + end +end + +! Expect one loop to copy the array contents to a temporary in function i. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 1 "original" } } + +! It should not emit code to check the contiguous property. +! { dg-final { scan-tree-dump-times "contiguous\\.\[0-9\]+" 0 "original" } } + diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-4.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-4.f90 new file mode 100644 index 0000000..b8b64ed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-4.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of the result of a function +! that returns a pointer to an array are generated properly after fixing +! pr103390, and that it does not ICE. + +program p + integer, pointer :: z(:) + integer, target :: x(3) = [1, 2, 3] + z => x + call s(i(z)) +contains + function i(x) + integer, pointer :: i(:) + integer, pointer :: x(:) + i => x + end + subroutine s(x) bind(c) + integer, contiguous :: x(:) + end +end + +! Expect a copy loop both before and after the call to S. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 2 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-5.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-5.f90 new file mode 100644 index 0000000..c87b979 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-5.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of the result of a function +! that returns a pointer to an array are generated properly after fixing +! pr103390, and that it does not ICE. This variant is for an intent(in) +! dummy argument so no copy-out is needed, only copy-in. + +program p + integer, pointer :: z(:) + integer, target :: x(3) = [1, 2, 3] + z => x + call s(i(z)) +contains + function i(x) + integer, pointer :: i(:) + integer, pointer :: x(:) + i => x + end + subroutine s(x) bind(c) + integer, contiguous, intent(in) :: x(:) + end +end + +! Expect a copy loop before the call to S. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-6.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-6.f90 new file mode 100644 index 0000000..394525b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-6.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of transpose result are +! generated properly after fixing pr103390, and that it does not ICE. +! This variant is for an intent(in) dummy argument so no copy-out +! is needed, only copy-in. + +program p + integer, pointer :: z(:,:) + integer, target :: x(3,3) = reshape ([1, 2, 3, 4, 5, 6, 7, 8, 9], shape(x)) + z => x + call s(transpose(z)) +contains + subroutine s(x) bind(c) + integer, contiguous, intent(in) :: x(:,:) + end +end + +! Expect 2 nested copy loops before the call to S. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 2 "original" } } + diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-7.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-7.f90 new file mode 100644 index 0000000..d86dc79 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-7.f90 @@ -0,0 +1,19 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of the result of an array +! section expression are generated properly after fixing pr103390, and +! that it does not ICE. + +program p + integer, pointer :: z(:) + integer :: A(5) = [1, 2, 3, 4, 5] + call s(A(::2)) +contains + subroutine s(x) bind(c) + integer, contiguous :: x(:) + end +end + +! Expect copy loops before and after the call to S. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 2 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-8.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-8.f90 new file mode 100644 index 0000000..3a3b3a8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-8.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of the result of an array +! section expression are generated properly after fixing pr103390, +! and that it does not ICE. This case is for an intent(in) +! dummy so no copy-out should occur, only copy-in. + +program p + integer, pointer :: z(:) + integer, parameter :: A(5) = [1, 2, 3, 4, 5] + call s(A(::2)) +contains + subroutine s(x) bind(c) + integer, contiguous, intent(in) :: x(:) + end +end + +! Expect a copy loop before the call to S. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103390-9.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103390-9.f90 new file mode 100644 index 0000000..62639f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr103390-9.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Check that copy loops to ensure contiguity of the result of an elemental +! array-valued expression are generated properly after fixing pr103390, +! and that it does not ICE. + +program p + integer, pointer :: z(:) + integer :: a(3) = [1, 2, 3]; + integer :: b(3) = [4, 5, 6]; + call s(a + b); +contains + subroutine s(x) bind(c) + integer, contiguous :: x(:) + end +end + +! We only expect one loop before the call, to fill in the contigous +! temporary. No copy-out is needed since the temporary is effectively +! an rvalue. +! { dg-final { scan-tree-dump-times "while \\(1\\)" 1 "original" } } + +! It should not emit code to check the contiguous property. +! { dg-final { scan-tree-dump-times "contiguous\\.\[0-9\]+" 0 "original" } } +