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 000..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])
+c
