[gcc r13-7412] Fortran: fix diagnostics for SELECT RANK [PR100607]

[gcc r13-7412] Fortran: fix diagnostics for SELECT RANK [PR100607]

[Harald Anlauf]

https://gcc.gnu.org/g:bedb3eb53308f0bbfacb55b608f23b009504d892

commit r13-7412-gbedb3eb53308f0bbfacb55b608f23b009504d892
Author: Steve Kargl <kargl@gcc.gnu.org>
Date:   Fri Jun 2 19:44:11 2023 +0200

    Fortran: fix diagnostics for SELECT RANK [PR100607]
    
    gcc/fortran/ChangeLog:
    
            PR fortran/100607
            * resolve.cc (resolve_select_rank): Remove duplicate error.
            (resolve_fl_var_and_proc): Prevent NULL pointer dereference and
            suppress error message for temporary.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/100607
            * gfortran.dg/select_rank_6.f90: New test.
    
    (cherry picked from commit fae09dfc0e6bf4cfe35d817558827aea78c6426f)

Diff:
---
 gcc/fortran/resolve.cc                      | 10 +++---
 gcc/testsuite/gfortran.dg/select_rank_6.f90 | 48 +++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 9748b425c78..417b20637e3 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10019,11 +10019,6 @@ resolve_select_rank (gfc_code *code, gfc_namespace *old_ns)
 			       || gfc_expr_attr (code->expr1).pointer))
 	gfc_error ("RANK (*) at %L cannot be used with the pointer or "
 		   "allocatable selector at %L", &c->where, &code->expr1->where);
-
-      if (case_value == -1 && (gfc_expr_attr (code->expr1).allocatable
-			       || gfc_expr_attr (code->expr1).pointer))
-	gfc_error ("RANK (*) at %L cannot be used with the pointer or "
-		   "allocatable selector at %L", &c->where, &code->expr1->where);
     }
 
   /* Add EXEC_SELECT to switch on rank.  */
@@ -13246,7 +13241,10 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
 
       if (allocatable)
 	{
-	  if (dimension && as->type != AS_ASSUMED_RANK)
+	  if (dimension
+	      && as
+	      && as->type != AS_ASSUMED_RANK
+	      && !sym->attr.select_rank_temporary)
 	    {
 	      gfc_error ("Allocatable array %qs at %L must have a deferred "
 			 "shape or assumed rank", sym->name, &sym->declared_at);
diff --git a/gcc/testsuite/gfortran.dg/select_rank_6.f90 b/gcc/testsuite/gfortran.dg/select_rank_6.f90
new file mode 100644
index 00000000000..d0121777bb5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_rank_6.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! PR fortran/100607 - fix diagnostics for SELECT RANK
+! Contributed by T.Burnus
+
+program p
+  implicit none
+  integer, allocatable :: A(:,:,:)
+
+  allocate(a(5:6,-2:2, 99:100))
+  call foo(a)
+  call bar(a)
+
+contains
+
+  subroutine foo(x)
+    integer, allocatable :: x(..)
+    if (rank(x) /= 3) stop 1
+    if (any (lbound(x) /= [5, -2, 99])) stop 2
+
+    select rank (x)
+    rank(3)
+      if (any (lbound(x) /= [5, -2, 99])) stop 3
+    end select
+
+    select rank (x) ! { dg-error "pointer or allocatable selector at .2." }
+    rank(*)         ! { dg-error "pointer or allocatable selector at .2." }
+      if (rank(x) /= 1) stop 4
+      if (lbound(x, 1) /= 1) stop 5
+    end select
+  end
+
+  subroutine bar(x)
+    integer :: x(..)
+    if (rank(x) /= 3) stop 6
+    if (any (lbound(x) /= 1)) stop 7
+
+    select rank (x)
+    rank(3)
+      if (any (lbound(x) /= 1)) stop 8
+    end select
+
+    select rank (x)
+    rank(*)
+      if (rank(x) /= 1) stop 9
+      if (lbound(x, 1) /= 1) stop 10
+    end select
+  end
+end