[gcc r13-4269] Fortran: error recovery on associate with bad selector [PR107577]

[gcc r13-4269] Fortran: error recovery on associate with bad selector [PR107577]

[Harald Anlauf]

https://gcc.gnu.org/g:2eaa0cc45e8eae0fc4a440d28c602964bcb1014d

commit r13-4269-g2eaa0cc45e8eae0fc4a440d28c602964bcb1014d
Author: Steve Kargl <kargl@gcc.gnu.org>
Date:   Tue Nov 22 22:31:51 2022 +0100

    Fortran: error recovery on associate with bad selector [PR107577]
    
    gcc/fortran/ChangeLog:
    
            PR fortran/107577
            * resolve.cc (find_array_spec): Choose appropriate locus either of
            bad array reference or of non-array entity in error message.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/107577
            * gfortran.dg/pr107577.f90: New test.

Diff:
---
 gcc/fortran/resolve.cc                 |  3 ++-
 gcc/testsuite/gfortran.dg/pr107577.f90 | 13 +++++++++++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 24e5aa03556..3396c6ce4a7 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5005,8 +5005,9 @@ find_array_spec (gfc_expr *e)
       case REF_ARRAY:
 	if (as == NULL)
 	  {
+	    locus loc = ref->u.ar.where.lb ? ref->u.ar.where : e->where;
 	    gfc_error ("Invalid array reference of a non-array entity at %L",
-		       &ref->u.ar.where);
+		       &loc);
 	    return false;
 	  }
 
diff --git a/gcc/testsuite/gfortran.dg/pr107577.f90 b/gcc/testsuite/gfortran.dg/pr107577.f90
new file mode 100644
index 00000000000..94e6620a0ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107577.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR fortran/107577 - ICE in find_array_spec
+! Contributed by G.Steinmetz
+
+program p
+  implicit none
+  associate (y => f(4))            ! { dg-error "has no IMPLICIT type" }
+    if (lbound (y, 1) /= 1) stop 1 ! { dg-error "Invalid array reference" }
+    if (y(1) /= 1) stop 2          ! { dg-error "Invalid array reference" }
+  end associate
+end
+
+! { dg-error "has no type" " " { target *-*-* } 7 }