From ad1614a7bf91e925ba8d93b8029c83e933ae482f Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Tue, 11 May 2010 11:43:16 -0400 Subject: [PATCH] re PR fortran/31820 (Warning if case label value exceeds maximum value for type) gcc/fortran/: 2010-05-11 Daniel Franke 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 PR fortran/31820 * gfortran.dg/select_5.f90: Updated. From-SVN: r159278 --- gcc/fortran/ChangeLog | 9 ++++++- gcc/fortran/resolve.c | 37 +++++++++++++++++++++----- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/select_5.f90 | 15 ++++++++--- 4 files changed, 55 insertions(+), 11 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index af70b8c67a6..1b8c65ceaa4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,9 +1,16 @@ +2010-05-11 Daniel Franke + + 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 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 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 5afb08d516f..da8d896cba5 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 c664140fe39..29b19b9c4e7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-05-11 Daniel Franke + + PR fortran/31820 + * gfortran.dg/select_5.f90: Updated. + 2010-05-11 Jan Hubicka PR tree-optimize/44063 diff --git a/gcc/testsuite/gfortran.dg/select_5.f90 b/gcc/testsuite/gfortran.dg/select_5.f90 index 2e2997c9bc4..9afc1603ba2 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 -- 2.30.2