[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.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 89de9d00fe2df49c96ad9d09994d4f11218046ab..c4ca48f6183d1b97a8b7d0921b3faa350a27f24a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2020-04-02  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/93522
+       * match.c (gfc_match_select_rank): Fix error cleanup.
+
 2020-04-02  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/93498

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 8443d20dc4f921019dfb2a99c9dd7655d4cc057b..8ae34a94a95841ea22c40c2595395b78e2e79625 100644 (file)
--- 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/ChangeLog b/gcc/testsuite/ChangeLog
index ac1695f60985bf3ee7022b024c22a9776bb62522..a154849a83755f82cc793935d91b46fd4c944f27 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2020-04-02  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/93522
+       * gfortran.dg/select_rank_4.f90: New.
+
 2020-04-02  Mark Eggleston  <mark.eggleston@codethink.com>
 
        PR fortran/93498

diff --git a/gcc/testsuite/gfortran.dg/select_rank_4.f90 b/gcc/testsuite/gfortran.dg/select_rank_4.f90
new file mode 100644 (file)
index 0000000..e670705
--- /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