re PR fortran/56081 (Seg fault ICE on select with bad case)

2013-01-23  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56081
	* resolve.c (resolve_select): Add argument 'select_type', reject
	non-scalar expressions.
	(resolve_select_type,resolve_code): Pass new argument to
	'resolve_select'.


2013-01-23  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56081
	* gfortran.dg/select_8.f90: New.

From-SVN: r195412

gcc/fortran/ChangeLog

+2013-01-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56081
+	* resolve.c (resolve_select): Add argument 'select_type', reject
+	non-scalar expressions.
+	(resolve_select_type,resolve_code): Pass new argument to
+	'resolve_select'.
+
 2013-01-23  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/56052

gcc/fortran/resolve.c

@@ -7935,7 +7935,7 @@ validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr)
    expression.  */
 
 static void
-resolve_select (gfc_code *code)
+resolve_select (gfc_code *code, bool select_type)
 {
   gfc_code *body;
   gfc_expr *case_expr;
@@ -7965,8 +7965,9 @@ resolve_select (gfc_code *code)
     }
 
   case_expr = code->expr1;
-
   type = case_expr->ts.type;
+
+  /* F08:C830.  */
   if (type != BT_LOGICAL && type != BT_INTEGER && type != BT_CHARACTER)
     {
       gfc_error ("Argument of SELECT statement at %L cannot be %s",
@@ -7976,6 +7977,16 @@ resolve_select (gfc_code *code)
       return;
     }
 
+  /* F08:R842.  */
+  if (!select_type && case_expr->rank != 0)
+    {
+      gfc_error ("Argument of SELECT statement at %L must be a scalar "
+		 "expression", &case_expr->where);
+
+      /* Punt.  */
+      return;
+    }
+
   /* Raise a warning if an INTEGER case value exceeds the range of
      the case-expr. Later, all expressions will be promoted to the
      largest kind of all case-labels.  */
@@ -8668,7 +8679,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
   gfc_resolve_blocks (code->block, gfc_current_ns);
   gfc_current_ns = old_ns;
 
-  resolve_select (code);
+  resolve_select (code, true);
 }
 
 
@@ -10285,7 +10296,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 	case EXEC_SELECT:
 	  /* Select is complicated. Also, a SELECT construct could be
 	     a transformed computed GOTO.  */
-	  resolve_select (code);
+	  resolve_select (code, false);
 	  break;
 
 	case EXEC_SELECT_TYPE:

gcc/testsuite/ChangeLog

+2013-01-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56081
+	* gfortran.dg/select_8.f90: New.
+
 2013-01-23  David Holsgrove <david.holsgrove@xilinx.com>
 
 	* gcc.target/microblaze/microblaze.exp: Remove target_config_cflags check

gcc/testsuite/gfortran.dg/select_8.f90

+! { dg-do compile }
+!
+! PR 56081: [4.7/4.8 Regression] Segfault ICE on select with bad case
+!
+! Contributed by Richard L Lozes <richard@lozestech.com>
+
+  implicit none
+  integer :: a(4)
+  select case(a)   ! { dg-error "must be a scalar expression" }
+  case (0)
+  end select
+end