re PR fortran/31820 (Warning if case label value exceeds maximum value for type)

gcc/fortran/:
2010-05-11  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/31820
	* resolve.c (validate_case_label_expr): Removed FIXME.
	(resolve_select): Raise default warning on case labels out of range
	of the case expression.

gcc/testsuite/:
2010-05-11  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/31820
	* gfortran.dg/select_5.f90: Updated.

From-SVN: r159278

4 files changed, 55 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af70b8c..1b8c65c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,9 +1,16 @@
+2010-05-11  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31820
+	* resolve.c (validate_case_label_expr): Removed FIXME.
+	(resolve_select): Raise default warning on case labels out of range
+	of the case expression.
+
 2010-05-10  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/27866
 	PR fortran/35003
 	PR fortran/42809
-	* intrinsic.c (gfc_convert_type_warn): Be more dicsriminative
+	* intrinsic.c (gfc_convert_type_warn): Be more discriminative
 	about conversion warnings.
 
 2010-05-10  Janus Weil  <janus@gcc.gnu.org>
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5afb08d..da8d896 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6747,8 +6747,9 @@ validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr)
       return FAILURE;
     }
 
-  /* Convert the case value kind to that of case expression kind, if needed.
-     FIXME:  Should a warning be issued?  */
+  /* Convert the case value kind to that of case expression kind,
+     if needed */
+
   if (e->ts.kind != case_expr->ts.kind)
     gfc_convert_type_warn (e, &case_expr->ts, 2, 0);
 
@@ -6834,6 +6835,31 @@ resolve_select (gfc_code *code)
       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.  */
+
+  if (type == BT_INTEGER)
+    for (body = code->block; body; body = body->block)
+      for (cp = body->ext.case_list; cp; cp = cp->next)
+	{
+	  if (cp->low
+	      && gfc_check_integer_range (cp->low->value.integer,
+					  case_expr->ts.kind) != ARITH_OK)
+	    gfc_warning ("Expression in CASE statement at %L is "
+			 "not in the range of %s", &cp->low->where,
+			 gfc_typename (&case_expr->ts));
+
+	  if (cp->high
+	      && cp->low != cp->high
+	      && gfc_check_integer_range (cp->high->value.integer,
+					  case_expr->ts.kind) != ARITH_OK)
+	    gfc_warning ("Expression in CASE statement at %L is "
+			 "not in the range of %s", &cp->high->where,
+			 gfc_typename (&case_expr->ts));
+	}
+
   /* PR 19168 has a long discussion concerning a mismatch of the kinds
      of the SELECT CASE expression and its CASE values.  Walk the lists
      of case values, and if we find a mismatch, promote case_expr to
@@ -6856,7 +6882,6 @@ resolve_select (gfc_code *code)
 		  && gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0)
 		continue;
 
-	      /* FIXME: Should a warning be issued?  */
 	      if (cp->low != NULL
 		  && case_expr->ts.kind != gfc_kind_max(case_expr, cp->low))
 		gfc_convert_type_warn (case_expr, &cp->low->ts, 2, 0);
@@ -6907,8 +6932,8 @@ resolve_select (gfc_code *code)
 
 	  /* Deal with single value cases and case ranges.  Errors are
 	     issued from the validation function.  */
-	  if(validate_case_label_expr (cp->low, case_expr) != SUCCESS
-	     || validate_case_label_expr (cp->high, case_expr) != SUCCESS)
+	  if (validate_case_label_expr (cp->low, case_expr) != SUCCESS
+	      || validate_case_label_expr (cp->high, case_expr) != SUCCESS)
 	    {
 	      t = FAILURE;
 	      break;
@@ -6930,7 +6955,7 @@ resolve_select (gfc_code *code)
 	      value = cp->low->value.logical == 0 ? 2 : 1;
 	      if (value & seen_logical)
 		{
-		  gfc_error ("constant logical value in CASE statement "
+		  gfc_error ("Constant logical value in CASE statement "
 			     "is repeated at %L",
 			     &cp->low->where);
 		  t = FAILURE;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c664140..29b19b9 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-05-11  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31820
+	* gfortran.dg/select_5.f90: Updated.
+
 2010-05-11  Jan Hubicka  <jh@suse.cz>
 
 	PR tree-optimize/44063
diff --git a/gcc/testsuite/gfortran.dg/select_5.f90 b/gcc/testsuite/gfortran.dg/select_5.f90
index 2e2997c..9afc160 100644
--- a/gcc/testsuite/gfortran.dg/select_5.f90
+++ b/gcc/testsuite/gfortran.dg/select_5.f90
@@ -3,13 +3,20 @@
 program select_5
   integer(kind=1) i          ! kind = 1, -128 <= i < 127
   do i = 1, 3
-    select case (i)     
-    case (1_4)         ! kind = 4, reachable
+    select case (i)
+
+    ! kind = 4, reachable
+    case (1_4)
       if (i /=  1_4) call abort
-    case (2_8)         ! kind = 8, reachable
+
+    ! kind = 8, reachable
+    case (2_8)
       if (i /= 2_8) call abort
-    case (200)         ! kind = 4, unreachable because of range of i
+
+    ! kind = 4, unreachable because of range of i
+    case (200)                       ! { dg-warning "not in the range" }
       call abort
+
     case default
       if (i /= 3) call abort
     end select