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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6825ab1..102f212 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c6a6756..ddb6d67 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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:

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7bfa569..8bcbca5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/select_8.f90 b/gcc/testsuite/gfortran.dg/select_8.f90
new file mode 100644 (file)
index 0000000..910d393
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_8.f90
@@ -0,0 +1,12 @@
+! { 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