Proxy ping [PATCH] Fortran: Fix automatic reallocation inside select rank [PR100103]

[Harald Anlauf <anlauf@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 564 bytes --]

Dear all,

the patch for this PR was submitted for review by Jose here:

  https://gcc.gnu.org/pipermail/fortran/2021-April/055934.html

but unfortunately was never reviewed.

I verified that it works on mainline and x86_64-pc-linux-gnu,
and I think that it is fine.

Although the above mail suggests that there is a dependency
on the fix for another PR with a rather lengthy patch,
it appears that this is no longer the case.  It might be
that the fix for PR100245 (another reallocation issue)
already did the necessary job.

So OK for mainline?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr100103.diff --]
[-- Type: text/x-patch, Size: 3521 bytes --]

From 6c93c5058f552f47a3d828d3fb19cca652901299 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 <jrfsousa@gmail.com>
Date: Wed, 21 Sep 2022 22:55:02 +0200
Subject: [PATCH] Fortran: Fix automatic reallocation inside select rank
 [PR100103]

gcc/fortran/ChangeLog:

	PR fortran/100103
	* trans-array.cc (gfc_is_reallocatable_lhs): Add select rank
	temporary associate names as possible targets of automatic
	reallocation.

gcc/testsuite/ChangeLog:

	PR fortran/100103
	* gfortran.dg/PR100103.f90: New test.
---
 gcc/fortran/trans-array.cc             |  4 +-
 gcc/testsuite/gfortran.dg/PR100103.f90 | 76 ++++++++++++++++++++++++++
 2 files changed, 78 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100103.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 05134952db4..795ce14af08 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10378,7 +10378,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)

   /* An allocatable class variable with no reference.  */
   if (sym->ts.type == BT_CLASS
-      && !sym->attr.associate_var
+      && (!sym->attr.associate_var || sym->attr.select_rank_temporary)
       && CLASS_DATA (sym)->attr.allocatable
       && expr->ref
       && ((expr->ref->type == REF_ARRAY && expr->ref->u.ar.type == AR_FULL
@@ -10393,7 +10393,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)

   /* An allocatable variable.  */
   if (sym->attr.allocatable
-      && !sym->attr.associate_var
+      && (!sym->attr.associate_var || sym->attr.select_rank_temporary)
       && expr->ref
       && expr->ref->type == REF_ARRAY
       && expr->ref->u.ar.type == AR_FULL)
diff --git a/gcc/testsuite/gfortran.dg/PR100103.f90 b/gcc/testsuite/gfortran.dg/PR100103.f90
new file mode 100644
index 00000000000..21405610a71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100103.f90
@@ -0,0 +1,76 @@
+! { dg-do run }
+!
+! Test the fix for PR100103
+!
+
+program main_p
+  implicit none
+
+  integer            :: i
+  integer, parameter :: n = 11
+
+  type :: foo_t
+    integer :: i
+  end type foo_t
+
+  type(foo_t), parameter :: a(*) = [(foo_t(i), i=1,n)]
+
+  type(foo_t),  allocatable :: bar_d(:)
+  class(foo_t), allocatable :: bar_p(:)
+  class(*),     allocatable :: bar_u(:)
+
+
+  call foo_d(bar_d)
+  if(.not.allocated(bar_d)) stop 1
+  if(any(bar_d%i/=a%i)) stop 2
+  deallocate(bar_d)
+  call foo_p(bar_p)
+  if(.not.allocated(bar_p)) stop 3
+  if(any(bar_p%i/=a%i)) stop 4
+  deallocate(bar_p)
+  call foo_u(bar_u)
+  if(.not.allocated(bar_u)) stop 5
+  select type(bar_u)
+  type is(foo_t)
+    if(any(bar_u%i/=a%i)) stop 6
+  class default
+    stop 7
+  end select
+  deallocate(bar_u)
+
+contains
+
+  subroutine foo_d(that)
+    type(foo_t), allocatable, intent(out) :: that(..)
+
+    select rank(that)
+    rank(1)
+      that = a
+    rank default
+      stop 8
+    end select
+  end subroutine foo_d
+
+  subroutine foo_p(that)
+    class(foo_t), allocatable, intent(out) :: that(..)
+
+    select rank(that)
+    rank(1)
+      that = a
+    rank default
+      stop 9
+    end select
+  end subroutine foo_p
+
+  subroutine foo_u(that)
+    class(*), allocatable, intent(out) :: that(..)
+
+    select rank(that)
+    rank(1)
+      that = a
+    rank default
+      stop 10
+    end select
+  end subroutine foo_u
+
+end program main_p
--
2.35.3