diff mbox series

Fortran: fix passing of zero-sized array arguments to procedures [PR86277]

Message ID trinity-ee69c69e-7b4c-48d6-8f89-a5c4467fd9e6-1686604365454@3c-app-gmx-bs01
State Accepted
Headers
Series Fortran: fix passing of zero-sized array arguments to procedures [PR86277] |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Harald Anlauf June 12, 2023, 9:12 p.m. UTC 
  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

Comments

Li, Pan2 via Gcc-patches June 13, 2023, 5:45 p.m. UTC | #1 
On Mon, Jun 12, 2023 at 11:12:45PM +0200, Harald Anlauf via Fortran wrote:
> 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?
> 

OK to commit.

I've reviewed the bugzilla exchange between Mikael and you,
and agree with committing this and opening a new PR to 
track the unneeded temporaries issue.
Harald Anlauf June 13, 2023, 7:33 p.m. UTC | #2 
Hi Steve,

On 6/13/23 19:45, Steve Kargl via Gcc-patches wrote:
> On Mon, Jun 12, 2023 at 11:12:45PM +0200, Harald Anlauf via Fortran wrote:
>> 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?
>>
>
> OK to commit.
>
> I've reviewed the bugzilla exchange between Mikael and you,
> and agree with committing this and opening a new PR to
> track the unneeded temporaries issue.

this is tracked here:

   https://gcc.gnu.org/bugzilla/show_bug.cgi?id=110241

Thanks for the review!

Harald
diff mbox series

Patch

From 773b2aae412145d61638a0423c5891c4dfd0f945 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
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 <mikael@gcc.gnu.org>
---
 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