re PR fortran/91729 (ICE in gfc_match_select_rank, at fortran/match.c:6586)

2019-09-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/91729
	* match.c (gfc_match_select_rank): Initialise 'as' to NULL.
	Check for a symtree in the selector expression before trying to
	assign a value to 'as'. Revert to gfc_error and go to cleanup
	after setting a MATCH_ERROR.

2019-09-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/91729
	* gfortran.dg/select_rank_2.f90 : Add two more errors in foo2.
	* gfortran.dg/select_rank_3.f90 : New test.

From-SVN: r276051

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7435a22..cd1ca75 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2019-09-23  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/91729
+       * match.c (gfc_match_select_rank): Initialise 'as' to NULL.
+       Check for a symtree in the selector expression before trying to
+       assign a value to 'as'. Revert to gfc_error and go to cleanup
+       after setting a MATCH_ERROR.
+
 2019-09-20  Tobias Burnus  <tobias@codesourcery.com>
 
        PR fortran/78260

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 56d9af0..9b9dbf1 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -6510,7 +6510,7 @@ gfc_match_select_rank (void)
   char name[GFC_MAX_SYMBOL_LEN];
   gfc_symbol *sym, *sym2;
   gfc_namespace *ns = gfc_current_ns;
-  gfc_array_spec *as;
+  gfc_array_spec *as = NULL;
 
   m = gfc_match_label ();
   if (m == MATCH_ERROR)
@@ -6538,13 +6538,21 @@ gfc_match_select_rank (void)
        }
 
       sym = expr1->symtree->n.sym;
-      sym2 = expr2->symtree->n.sym;
 
-      as = sym2->ts.type == BT_CLASS ? CLASS_DATA (sym2)->as : sym2->as;
+      if (expr2->symtree)
+       {
+         sym2 = expr2->symtree->n.sym;
+         as = sym2->ts.type == BT_CLASS ? CLASS_DATA (sym2)->as : sym2->as;
+       }
+
       if (expr2->expr_type != EXPR_VARIABLE
          || !(as && as->type == AS_ASSUMED_RANK))
-       gfc_error_now ("The SELECT RANK selector at %C must be an assumed "
-                      "rank variable");
+       {
+         gfc_error ("The SELECT RANK selector at %C must be an assumed "
+                    "rank variable");
+         m = MATCH_ERROR;
+         goto cleanup;
+       }
 
       if (expr2->ts.type == BT_CLASS)
        {
@@ -6583,12 +6591,20 @@ gfc_match_select_rank (void)
          return m;
        }
 
-      sym = expr1->symtree->n.sym;
-      as = sym->ts.type == BT_CLASS ? CLASS_DATA (sym)->as : sym->as;
+      if (expr1->symtree)
+       {
+         sym = expr1->symtree->n.sym;
+         as = sym->ts.type == BT_CLASS ? CLASS_DATA (sym)->as : sym->as;
+       }
+
       if (expr1->expr_type != EXPR_VARIABLE
          || !(as && as->type == AS_ASSUMED_RANK))
-       gfc_error_now ("The SELECT RANK selector at %C must be an assumed "
-                      "rank variable");
+       {
+         gfc_error("The SELECT RANK selector at %C must be an assumed "
+                   "rank variable");
+         m = MATCH_ERROR;
+         goto cleanup;
+       }
     }
 
   m = gfc_match (" )%t");

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 815aee0..cd7ee8d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-09-23  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/91729
+       * gfortran.dg/select_rank_2.f90 : Add two more errors in foo2.
+       * gfortran.dg/select_rank_3.f90 : New test.
+
 2019-09-23  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        * gnat.dg/system_info1.adb: Sort dg-do target list.

diff --git a/gcc/testsuite/gfortran.dg/select_rank_2.f90 b/gcc/testsuite/gfortran.dg/select_rank_2.f90
index 2415fdf..184027f 100644 (file)
--- a/gcc/testsuite/gfortran.dg/select_rank_2.f90
+++ b/gcc/testsuite/gfortran.dg/select_rank_2.f90
@@ -8,9 +8,9 @@ subroutine foo1 (arg)
   integer :: i
   integer, dimension(3) :: arg
   select rank (arg)   ! { dg-error "must be an assumed rank variable" }
-    rank (3)
+    rank (3)          ! { dg-error "Unexpected RANK statement" }
     print *, arg
-  end select
+  end select          ! { dg-error "Expecting END SUBROUTINE" }
 end
 
 subroutine foo2 (arg)

diff --git a/gcc/testsuite/gfortran.dg/select_rank_3.f90 b/gcc/testsuite/gfortran.dg/select_rank_3.f90
new file mode 100644 (file)
index 0000000..35cd8cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_rank_3.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! Test the fix for PR91729
+!
+! Contributed by Gerhardt Steinmetz  <gscfq@t-online.de>
+!
+subroutine s(x)
+   integer :: x(..)
+   select rank (-x)       ! { dg-error "must be an assumed rank" }
+     rank (1)             ! { dg-error "Unexpected RANK statement" }
+       print *, x         ! { dg-error "may only be used as actual argument" }
+   end select             ! { dg-error "Expecting END SUBROUTINE" }
+end
+
+subroutine t(x)
+   integer :: x(..)
+   select rank (z => -x)  ! { dg-error "must be an assumed rank" }
+     rank (1)             ! { dg-error "Unexpected RANK statement" }
+       print *, z
+   end select             ! { dg-error "Expecting END SUBROUTINE" }
+end