[gcc r10-10109] Fortran: Fix some select rank issues [PR97694 and 97723].

[Harald Anlauf]

https://gcc.gnu.org/g:25d45b5dd41a9ab005a5ae8ee8e54be17f2467a2

commit r10-10109-g25d45b5dd41a9ab005a5ae8ee8e54be17f2467a2
Author: Paul Thomas <pault@gcc.gnu.org>
Date:   Sun Dec 27 14:59:38 2020 +0000

    Fortran: Fix some select rank issues [PR97694 and 97723].
    
    2020-12-27  Paul Thomas  <pault@gcc.gnu.org>
    
    gcc/fortran
            PR fortran/97694
            PR fortran/97723
            * check.c (allocatable_check): Select rank temporaries are
            permitted even though they are treated as associate variables.
            * resolve.c (gfc_resolve_code): Break on select rank as well as
            select type so that the block os resolved.
            * trans-stmt.c (trans_associate_var): Class associate variables
            that are optional dummies must use the backend_decl.
    
    gcc/testsuite/
            PR fortran/97694
            PR fortran/97723
            * gfortran.dg/select_rank_5.f90: New test.
    
    (cherry picked from commit c4a678981572c12d158709ace0d3f23dd04cf217)

Diff:
---
 gcc/fortran/check.c                         | 13 +++++----
 gcc/fortran/resolve.c                       |  5 ++--
 gcc/fortran/trans-stmt.c                    |  2 +-
 gcc/testsuite/gfortran.dg/select_rank_5.f90 | 44 +++++++++++++++++++++++++++++
 4 files changed, 55 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 1042f38486e..ad3cffe2d8e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -289,7 +289,7 @@ bin2real (gfc_expr *x, int kind)
 }
 
 
-/* Fortran 2018 treats a BOZ as simply a string of bits.  gfc_boz2real () 
+/* Fortran 2018 treats a BOZ as simply a string of bits.  gfc_boz2real ()
    converts the string into a REAL of the appropriate kind.  The treatment
    of the sign bit is processor dependent.  */
 
@@ -377,12 +377,12 @@ gfc_boz2real (gfc_expr *x, int kind)
 }
 
 
-/* Fortran 2018 treats a BOZ as simply a string of bits.  gfc_boz2int () 
+/* Fortran 2018 treats a BOZ as simply a string of bits.  gfc_boz2int ()
    converts the string into an INTEGER of the appropriate kind.  The
    treatment of the sign bit is processor dependent.  If the  converted
    value exceeds the range of the type, then wrap-around semantics are
    applied.  */
- 
+
 bool
 gfc_boz2int (gfc_expr *x, int kind)
 {
@@ -974,7 +974,8 @@ allocatable_check (gfc_expr *e, int n)
   symbol_attribute attr;
 
   attr = gfc_variable_attr (e, NULL);
-  if (!attr.allocatable || attr.associate_var)
+  if (!attr.allocatable
+     || (attr.associate_var && !attr.select_rank_temporary))
     {
       gfc_error ("%qs argument of %qs intrinsic at %L must be ALLOCATABLE",
 		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
@@ -3236,7 +3237,7 @@ gfc_check_intconv (gfc_expr *x)
       || strcmp (gfc_current_intrinsic, "long") == 0)
     {
       gfc_error ("%qs intrinsic subprogram at %L has been deprecated.  "
-		 "Use INT intrinsic subprogram.", gfc_current_intrinsic, 
+		 "Use INT intrinsic subprogram.", gfc_current_intrinsic,
 		 &x->where);
       return false;
     }
@@ -3964,7 +3965,7 @@ gfc_check_findloc (gfc_actual_arglist *ap)
   /* Check the kind of the characters argument match.  */
   if (a1 && v1 && a->ts.kind != v->ts.kind)
     goto incompat;
-	 
+
   d = ap->next->next->expr;
   m = ap->next->next->next->expr;
   k = ap->next->next->next->next->expr;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3bfee676139..21e3332b5c0 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11742,8 +11742,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
 	      gfc_resolve_omp_do_blocks (code, ns);
 	      break;
 	    case EXEC_SELECT_TYPE:
-	      /* Blocks are handled in resolve_select_type because we have
-		 to transform the SELECT TYPE into ASSOCIATE first.  */
+	    case EXEC_SELECT_RANK:
+	      /* Blocks are handled in resolve_select_type/rank because we
+		 have to transform the SELECT TYPE into ASSOCIATE first.  */
 	      break;
             case EXEC_DO_CONCURRENT:
 	      gfc_do_concurrent_flag = 1;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index a425c98c076..27d885d1c89 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1757,7 +1757,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       if (e->ts.type == BT_CLASS)
 	{
 	  /* Go straight to the class data.  */
-	  if (sym2->attr.dummy)
+	  if (sym2->attr.dummy && !sym2->attr.optional)
 	    {
 	      class_decl = DECL_LANG_SPECIFIC (sym2->backend_decl) ?
 			   GFC_DECL_SAVED_DESCRIPTOR (sym2->backend_decl) :
diff --git a/gcc/testsuite/gfortran.dg/select_rank_5.f90 b/gcc/testsuite/gfortran.dg/select_rank_5.f90
new file mode 100644
index 00000000000..55aa9e1b9bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_rank_5.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! Test the fixes for PR97723 and PR97694.
+!
+! Contributed by Martin  <mscfd@gmx.net>
+!
+module mod
+   implicit none
+   private
+   public cssel
+
+contains
+
+function cssel(x) result(s)
+   character(len=:), allocatable :: s
+   class(*), dimension(..), optional, intent(in) :: x
+   if (present(x)) then
+      select rank (x)
+      rank (0)
+         s = '0' ! PR97723: ‘assign’ at (1) is not a function
+                 ! PR97694: ICE in trans-stmt.c(trans_associate_var)
+      rank (1)
+         s = '1' ! PR97723: ‘assign’ at (1) is not a function
+      rank default
+         s = '?' ! PR97723: ‘assign’ at (1) is not a function
+      end select
+   else
+      s = '-'
+   end if
+end function cssel
+
+end module mod
+
+program classstar_rank
+   use mod
+   implicit none
+
+   integer :: x
+   real, dimension(1:3) :: y
+   logical, dimension(1:2,1:2) :: z
+
+   if (any ([cssel(x),cssel(y),cssel(z),cssel()] .ne. ['0','1','?','-'])) stop 1
+
+end program classstar_rank