From patchwork Mon Jun 12 21:12:45 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 106891 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:994d:0:b0:3d9:f83d:47d9 with SMTP id k13csp136171vqr; Mon, 12 Jun 2023 14:13:36 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ5Z+SJ96M3FH6ukBAUYUka3HjX4PD00y4ICvYABXvetNR0lQcduJj5n3T5ANbNSi91Ve74S X-Received: by 2002:a17:907:705:b0:978:96ba:f987 with SMTP id xb5-20020a170907070500b0097896baf987mr11376308ejb.10.1686604415898; Mon, 12 Jun 2023 14:13:35 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1686604415; cv=none; d=google.com; s=arc-20160816; b=kKQvdpVyhEGAlSvvZDZSQcnr/YOOkptBQOpKkyX+XnEjLJOoqYesbuYqo0rxhSMZqS shmHWuaS4l3X7n9tOZ6mn7GGFwrex7GqjZUJV1vXfRg2XxuZKZPw4wMdonBZ3bmcKaRI kh7nnZ1T0GGIgik4Ij6Pz+nnXyVSBBW4KoXRx5X6yCHq+GfdlDDaObYKkhi98TGXMWGk ZiHVPy3F7vfGOtMR8CDDWT1o8hJLkYb0p3m94D4sjmqd4SbURO+kZx7kxtzSX2MUel8h uIRgi21NunYiaVcV8d5nrg1qCk+ilw2fDFNnoy0gxhw/d5pahZF+OLhlCG6iABmJC6C5 rcwg== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=p8LyBahN1awMPvGQaRLqwimYv8W2ZAjz6ZQS0Uh2ra0=; b=B9ti7MVIZuOmYskYFdQePoypMzfhYAEVdwH8xjXJjx/F69GhOgKu5ehTww+4p1MMWh z/ZpWBw/Y0KQpkLOaiqXL7rMzlC9340LxmsVC48131VKIzV8523arRRgKJeoHJPtmv6E J38QUGjTN2Ubs61FSOay9Ic86Hu3F9Ir7ITraH+FsoDdcdTcRaFwoN8TuODNwj9UXbez ZCS5r3Stncj0vOM1vbWP52goXgcDm9BAF3Q0xIbHnyPBBXC79A27Y9o1YrzkEVs5ITrD IJgoqO2GVww14e5oV9lCtCO7H981n9PPK4Pz4nrF1TFAvIEJUlFoxoAqlOD2j3U4eIhJ YJvA== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=NjksKVmy; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id ko25-20020a170907987900b009749b844883si5725953ejc.368.2023.06.12.14.13.35 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 12 Jun 2023 14:13:35 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=NjksKVmy; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0540A3858425 for ; Mon, 12 Jun 2023 21:13:33 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 0540A3858425 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1686604413; bh=p8LyBahN1awMPvGQaRLqwimYv8W2ZAjz6ZQS0Uh2ra0=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=NjksKVmykPO5AnbgMIjtlZmYYp7iWeIrCneIoD+aJWN6JEoyb+6XsAUwcQnaTLiRO NjrlU+U6he605i/eeqjUrXK62BDZxVulv4gpIpYdruL1GFHiMko/Qk8kSRoxIwTSTj kY/y5kfNakhpwqHnNQO/pi3KxXRN3smgTfBJTLfY= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id F04983858D20; Mon, 12 Jun 2023 21:12:46 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org F04983858D20 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.84.180] ([93.207.84.180]) by web-mail.gmx.net (3c-app-gmx-bs01.server.lan [172.19.170.50]) (via HTTP); Mon, 12 Jun 2023 23:12:45 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: fix passing of zero-sized array arguments to procedures [PR86277] Date: Mon, 12 Jun 2023 23:12:45 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:3Yu7R8DsAV4dnzIY39361kXOITYg5EKHntIp5vC6R4ReJbVSCHhjWlxLJ+udS6aO5qoyH EdoiImEviUaDQ9lVza3+KrgVUsGXby7Zf8YkqA39yGjJH03zA0/QE1cBdf3hs/AADG7+0YwL4Dab ICoBtTKbTZxmFnmSyB6jzSSnMTtjVtqwHY+dDVFyww6/P8Ic7UACU0ODDWJ0GRvD6tj/8RpWQOoR ZDvCA8O9FCyUXN8HUa3tJehEZXvbBVmd1SEJhFGqW2dpS4PSJM/c1hRaAZZ3V81FZp5kKz+XEqtv t0= UI-OutboundReport: notjunk:1;M01:P0:B9dRbqUJmWI=;s3wCu166hZbQhy7QupgCc9FLquk ZdigwHIhhHuJkEE8M0kYJfqc+WmbrEphLp8iw4rxSZo+Ip9BH7wlwS82/sG23qguFPA5RpkIg GxGEGxRBZqUQRNpKth1K0VDUIRcKS/N43ZrQIvjkdr/6mOz4wTZTC63gJX0Tw/0vE/qAebswu d+OIV3CugXhwQ6aNeYRkS7t4ZO73e7/zx3WQOVaby36gWY0h411v57+GMNAcer6ugIhwzAe18 ERDYn1Fs8KfdZCHs73M2nZo87qQQUO0fEWxwp3XD3h0VMih8TAJg3JlKlDl5LVluP6bRAA+r0 vJGB8nUSEn6yCGLsKnDK9a0RClpBoJz4sndZ1p807c8K6/PXGq5/ldpvCxt+zDI9Gi98k/hjZ QJg2XdyxKuol5aIJOsLTc38NnHGB340dYK29YY9R6u9YnC3ksaZ3619ag+kqDKZp4E7LvCNkp GlXK/QjO4VpRydExL6KPuCaKW6W3YCGTX+X4RngsjoqU3bEy6ym8LMM/p19TDDcGea6E5YI8/ fQZmcfWOmucqlmjbqZK55lVVmhAHXtxdTz12o/5Uhr0yKzgIx0jpVMUaIYo3lcvCDiDZpDwWz aIg1P17IeTQxEDkQg8QakC/ShorMNCYRwx2oMVop5wNfLa29Fr/6OBQsjfUPEfkqvJhmDSYT9 5wIknJAyqiza7Z2jwrRaneHhSoC22a1ODZrqUhuTEms4rdIZ9E1iniULYCMdS+FjLbg25NfhX 5DjYN7BXfKHUdQn8QNUmbfM4z0rRts8HHknvNjiGlT0auD1uz40cHaJ5c1nUyKPlcZ/rnokm7 S8a+IKWVtQU2BVmKJdDmzzk4ctfA6m9d4Yr4BJoMXBbTI= X-Spam-Status: No, score=-12.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H5, RCVD_IN_MSPIKE_WL, 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1768532911899971715?= X-GMAIL-MSGID: =?utf-8?q?1768532911899971715?= Dear all, the attached - actually rather small - patch is the result of a rather intensive session with Mikael in an attempt to fix the situation that we did not create proper temporaries when passing zero-sized array arguments to procedures. When the dummy argument was declared as OPTIONAL, in many cases it was mis-detected as non-present. This also depended on the type of argument, and was different for different intrinsic types, notably character, and derived types, and should explain the rather large ratio of the size of the provided testcases to the actual fix... (What the patch does not address: we still generate too much code for unneeded temporaries, often two temporaries instead of just one. I'll open a separate PR to track this.) Regtested on x86_64-pc-linux-gnu. OK for mainline? If this survives long enough on 14-trunk, would this be eligible for a backport to 13-branch in time for 13.2? Thanks, Harald From 773b2aae412145d61638a0423c5891c4dfd0f945 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 12 Jun 2023 23:08:48 +0200 Subject: [PATCH] Fortran: fix passing of zero-sized array arguments to procedures [PR86277] gcc/fortran/ChangeLog: PR fortran/86277 * trans-array.cc (gfc_trans_allocate_array_storage): When passing a zero-sized array with fixed (= non-dynamic) size, allocate temporary by the caller, not by the callee. gcc/testsuite/ChangeLog: PR fortran/86277 * gfortran.dg/zero_sized_14.f90: New test. * gfortran.dg/zero_sized_15.f90: New test. Co-authored-by: Mikael Morin --- gcc/fortran/trans-array.cc | 2 +- gcc/testsuite/gfortran.dg/zero_sized_14.f90 | 181 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/zero_sized_15.f90 | 114 ++++++++++++ 3 files changed, 296 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/zero_sized_14.f90 create mode 100644 gcc/testsuite/gfortran.dg/zero_sized_15.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index e1c75e9fe02..e7c51bae052 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1117,7 +1117,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, desc = info->descriptor; info->offset = gfc_index_zero_node; - if (size == NULL_TREE || integer_zerop (size)) + if (size == NULL_TREE || (dynamic && integer_zerop (size))) { /* A callee allocated array. */ gfc_conv_descriptor_data_set (pre, desc, null_pointer_node); diff --git a/gcc/testsuite/gfortran.dg/zero_sized_14.f90 b/gcc/testsuite/gfortran.dg/zero_sized_14.f90 new file mode 100644 index 00000000000..32c7ae28e3a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/zero_sized_14.f90 @@ -0,0 +1,181 @@ +! { dg-do run } +! PR fortran/86277 +! +! Check proper detection of presence of optional array dummy arguments +! for zero-sized actual array arguments or array constructors: +! tests for REAL (as non-character intrinsic type) and empty derived type + +program test + implicit none + real, parameter :: m(0) = 42. + real, parameter :: n(1) = 23. + real :: x(0) = 1. + real :: z(1) = 2. + real :: w(0) + real, pointer :: p(:) + real, allocatable :: y(:) + integer :: k = 0, l = 0 ! Test/failure counter + type dt + ! Empty type + end type dt + type(dt), parameter :: t0(0) = dt() + type(dt), parameter :: t1(1) = dt() + type(dt) :: t2(0) = dt() + type(dt) :: t3(1) = dt() + type(dt) :: t4(0) + type(dt), allocatable :: tt(:) + ! + allocate (p(0)) + allocate (y(0)) + allocate (tt(0)) + call a0 () + call a1 () + call a2 () + call a3 () + call all_missing () + print *, "Total tests:", k, " failed:", l +contains + subroutine a0 () + print *, "Variables as actual argument" + call i (m) + call i (n) + call i (x) + call i (w) + call i (y) + call i (p) + call j (t0) + call j (t1) + call j (t2) + call j (t3) + call j (t4) + call j (tt) + print *, "Array section as actual argument" + call i (m(1:0)) + call i (n(1:0)) + call i (x(1:0)) + call i (w(1:0)) + call i (z(1:0)) + call i (p(1:0)) + call j (t0(1:0)) + call j (t1(1:0)) + call j (t2(1:0)) + call j (t3(1:0)) + call j (t4(1:0)) + call j (tt(1:0)) + end subroutine a0 + ! + subroutine a1 () + print *, "Explicit temporary as actual argument" + call i ((m)) + call i ((n)) + call i ((n(1:0))) + call i ((x)) + call i ((w)) + call i ((z(1:0))) + call i ((y)) + call i ((p)) + call i ((p(1:0))) + call j ((t0)) + call j ((t1)) + call j ((tt)) + call j ((t1(1:0))) + call j ((tt(1:0))) + end subroutine a1 + ! + subroutine a2 () + print *, "Array constructor as actual argument" + call i ([m]) + call i ([n]) + call i ([x]) + call i ([w]) + call i ([z]) + call i ([m(1:0)]) + call i ([n(1:0)]) + call i ([m,n(1:0)]) + call i ([x(1:0)]) + call i ([w(1:0)]) + call i ([z(1:0)]) + call i ([y]) + call i ([p]) + call i ([y,y]) + call i ([p,p]) + call i ([y(1:0)]) + call i ([p(1:0)]) + call j ([t0]) + call j ([t0,t0]) + call j ([t1]) + call j ([tt]) + call j ([tt,tt]) + call j ([t1(1:0)]) + call j ([tt(1:0)]) + end subroutine a2 + ! + subroutine a3 () + print *, "Array constructor with type-spec as actual argument" + call i ([real:: ]) + call i ([real:: 7]) + call i ([real:: m]) + call i ([real:: n]) + call i ([real:: x]) + call i ([real:: w]) + call i ([real:: m(1:0)]) + call i ([real:: n(1:0)]) + call i ([real:: m,n(1:0)]) + call i ([real:: x(1:0)]) + call i ([real:: w(1:0)]) + call i ([real:: z(1:0)]) + call i ([real:: y]) + call i ([real:: p]) + call i ([real:: y,y]) + call i ([real:: p,p]) + call i ([real:: y(1:0)]) + call i ([real:: p(1:0)]) + call j ([ dt :: ]) + call j ([ dt :: t0]) + call j ([ dt :: t0,t0]) + call j ([ dt :: t1]) + call j ([ dt :: tt]) + call j ([ dt :: tt,tt]) + call j ([ dt :: t1(1:0)]) + call j ([ dt :: tt(1:0)]) + end subroutine a3 + ! + subroutine i (arg) + real, optional, intent(in) :: arg(:) + logical :: t + t = present (arg) + k = k + 1 + print *, 'test', k, merge (" ok", "FAIL", t) + if (.not. t) l = l + 1 + if (.not. t) stop k + end subroutine i + ! + subroutine j (arg) + type(dt), optional, intent(in) :: arg(:) + logical :: t + t = present (arg) + k = k + 1 + print *, 'test', k, merge (" ok", "FAIL", t) + if (.not. t) l = l + 1 + if (.not. t) stop k + end subroutine j + ! + subroutine all_missing (arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) + real, optional, intent(in) :: arg1(:) + real, optional, allocatable :: arg2(:) + real, optional, pointer :: arg3(:) + character(*), optional, intent(in) :: arg4(:) + character(*), optional, allocatable :: arg5(:) + character(*), optional, pointer :: arg6(:) + character(:), optional, pointer :: arg7(:) + character(:), optional, allocatable :: arg8(:) + if (present (arg1)) stop 101 + if (present (arg2)) stop 102 + if (present (arg3)) stop 103 + if (present (arg4)) stop 104 + if (present (arg5)) stop 105 + if (present (arg6)) stop 106 + if (present (arg7)) stop 107 + if (present (arg8)) stop 108 + end subroutine all_missing +end program diff --git a/gcc/testsuite/gfortran.dg/zero_sized_15.f90 b/gcc/testsuite/gfortran.dg/zero_sized_15.f90 new file mode 100644 index 00000000000..c7d12ae7173 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/zero_sized_15.f90 @@ -0,0 +1,114 @@ +! { dg-do run } +! PR fortran/86277 +! +! Check proper detection of presence of optional array dummy arguments +! for zero-sized actual array arguments or array constructors: +! tests for CHARACTER + +program test + implicit none + character(0), parameter :: c0(0) = "" + character(0), parameter :: c1(1) = "" + character(1), parameter :: d0(0) = "" + character(1), parameter :: d1(1) = "" + character(0) :: w0(0) + character(0) :: w1(1) + character(:), allocatable :: cc(:) + integer :: k = 0, l = 0 ! Test/failure counter + ! + allocate (character(0) :: cc(0)) + call a0 () + call a1 () + call a2 () + call a3 () + print *, "Total tests:", k, " failed:", l +contains + subroutine a0 () + print *, "Variables as actual argument" + call i (c0) + call i (c1) + call i (d0) + call i (d1) + call i (w0) + call i (w1) + call i (cc) + print *, "Array section as actual argument" + call i (c1(1:0)) + call i (c1(1:0)(1:0)) + call i (w1(1:0)) + call i (w1(1:0)(1:0)) + call i (cc(1:0)) + call i (cc(1:0)(1:0)) + end subroutine a0 + ! + subroutine a1 () + print *, "Explicit temporary as actual argument" + call i ((c0)) + call i ((c1)) + call i ((d0)) + call i ((d1)) + call i ((w0)) + call i ((w1)) + call i ((cc)) + call i ((c1(1:0))) + call i ((c1(1:0)(1:0))) + call i ((w1(1:0))) + call i ((w1(1:0)(1:0))) + call i ((cc(1:0))) + call i ((cc(1:0)(1:0))) + end subroutine a1 + ! + subroutine a2 () + print *, "Array constructor as actual argument" + call i ([c0]) + call i ([c1]) + call i ([d0]) + call i ([d1]) + call i ([w0]) + call i ([w1]) + call i ([cc]) + call i ([c0,c0]) + call i ([c1,c1]) + call i ([d0,d0]) + call i ([cc,cc]) + call i ([c1(1:0)]) + call i ([c1(1:0)(1:0)]) + call i ([w1(1:0)]) + call i ([w1(1:0)(1:0)]) + call i ([cc(1:0)]) + call i ([cc(1:0)(1:0)]) + end subroutine a2 + ! + subroutine a3 () + print *, "Array constructor with type-spec as actual argument" + call i ([character(0) :: ]) + call i ([character(0) :: ""]) + call i ([character(0) :: c0]) + call i ([character(0) :: c1]) + call i ([character(0) :: d0]) + call i ([character(0) :: d1]) + call i ([character(0) :: w0]) + call i ([character(0) :: w1]) + call i ([character(0) :: cc]) + call i ([character(0) :: c0,c0]) + call i ([character(0) :: c1,c1]) + call i ([character(0) :: d0,d0]) + call i ([character(0) :: cc,cc]) + call i ([character(0) :: c1(1:0)]) + call i ([character(0) :: c1(1:0)(1:0)]) + call i ([character(0) :: w1(1:0)]) + call i ([character(0) :: w1(1:0)(1:0)]) + call i ([character(0) :: cc(1:0)]) + call i ([character(0) :: cc(1:0)(1:0)]) + end subroutine a3 + ! + subroutine i(arg) + character(*), optional, intent(in) :: arg(:) + logical :: t + t = present (arg) + k = k + 1 + print *, 'test', k, merge (" ok", "FAIL", t) + if (.not. t) l = l + 1 + if (.not. t) stop k + end subroutine i +end program -- 2.35.3