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

gcc/fortran/ChangeLog

+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

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;
 
+      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 "
+	{
+	  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;
 	}
 
+      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 "
+	{
+	  gfc_error("The SELECT RANK selector at %C must be an assumed "
 		    "rank variable");
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
     }
 
   m = gfc_match (" )%t");

gcc/testsuite/ChangeLog

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

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)

gcc/testsuite/gfortran.dg/select_rank_3.f90

+! { 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