[Patch][Fortran] Fix error cleanup of select rank (PR93522)

[Tobias Burnus <Tobias_Burnus@mentor.com>]

[-- Attachment #1: Type: text/plain, Size: 835 bytes --]

Hi all,

here, the reject_statement cleanup and the freeing of the
namespace both remove the symbol. Solution: Remove it first,
then clean the namespace – then the reject_statement has no
(deleted) statement to cleanup.

As select rank is new, that's again a GCC-10 only
regression (of invalid code).

OK?

Tobias

PS: valgrind shows
==71237==    definitely lost: 0 bytes in 0 blocks
==71237==    indirectly lost: 0 bytes in 0 blocks
==71237==      possibly lost: 0 bytes in 0 blocks
I did ignore:
==52255==    still reachable: 500,682 bytes in 2,181 blocks
which is the same also with 'select... end select' commented.

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Attachment #2: select-rank.diff --]
[-- Type: text/x-patch, Size: 1870 bytes --]

[Fortran] Fix error cleanup of select rank (PR93522)

	PR fortran/93522
	* match.c (gfc_match_select_rank): Fix error cleanup.

	PR fortran/93522
	* gfortran.dg/select_rank_4.f90: New.

 gcc/fortran/match.c                         |  1 +
 gcc/testsuite/gfortran.dg/select_rank_4.f90 | 26 ++++++++++++++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 8443d20dc4f..8ae34a94a95 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -6678,6 +6678,7 @@ gfc_match_select_rank (void)
 
       if (m != MATCH_YES)
 	{
+	  gfc_undo_symbols ();
 	  std::swap (ns, gfc_current_ns);
 	  gfc_free_namespace (ns);
 	  return m;
diff --git a/gcc/testsuite/gfortran.dg/select_rank_4.f90 b/gcc/testsuite/gfortran.dg/select_rank_4.f90
new file mode 100644
index 00000000000..e67070531d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_rank_4.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/93522
+!
+! Contributed by Shubham Narlawar
+
+program rank_new
+    implicit none
+    integer :: some_var_assumed
+    integer, DIMENSION(3,2,1) :: array
+    PRINT *, RANK(array)
+   call CALL_ME(array)
+   contains
+!No error expected
+  subroutine CALL_ME23(x)
+                implicit none
+                integer:: x(..), a=10,b=20
+                integer, dimension(10) :: arr = (/1,2,3,4,5/)  ! { dg-error "Different shape for array assignment at .1. on dimension 1 .10 and 5." }
+                select rank(arr(1:3))  ! { dg-error "Syntax error in argument list" }
+                RANK(1)  ! { dg-error "Unexpected RANK statement" }
+                        print *, "1"
+                 rank(2)  ! { dg-error "Unexpected RANK statement" }
+                        print *, "2"
+                end select  ! { dg-error "Expecting END SUBROUTINE statement" }
+        end subroutine
+end program