[gcc r12-8803] Fortran: Fix automatic reallocation inside select rank [PR100103]

[gcc r12-8803] Fortran: Fix automatic reallocation inside select rank [PR100103]

[Harald Anlauf]

https://gcc.gnu.org/g:56275fd23e3f7876c24a812f9b6776b00a94744e

commit r12-8803-g56275fd23e3f7876c24a812f9b6776b00a94744e
Author: José Rui Faustino de Sousa <jrfsousa@gmail.com>
Date:   Wed Sep 21 22:55:02 2022 +0200

    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.
    
    (cherry picked from commit 12b537b9b7fd50f4b2fbfcb7ccf45f8d66085577)

Diff:
---
 gcc/fortran/trans-array.cc             |  4 +-
 gcc/testsuite/gfortran.dg/PR100103.f90 | 76 ++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+), 2 deletions(-)

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