diff mbox series

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

Message ID trinity-1ab43e1e-5c92-41b1-aa71-2063c3d470fb-1663794424632@3c-app-gmx-bap37
State New
Headers
Series Proxy ping [PATCH] Fortran: Fix automatic reallocation inside select rank [PR100103] |

Commit Message

Harald Anlauf Sept. 21, 2022, 9:07 p.m. UTC 
  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

Comments

Thomas Koenig Sept. 22, 2022, 5:46 a.m. UTC | #1 
Hello Harald,

> 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?

Looks good to me. Thanks for picking up these patches!

Best regards

	Thomas
diff mbox series

Patch

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