From: Richard Henderson Date: Thu, 26 Aug 2004 06:07:52 +0000 (-0700) Subject: arith.c (gfc_validate_kind): Add may_fail argument; abort if false and we don't valid... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e7a2d5fb772b33ef161b201d579b6d58c5fb1ed1;p=gcc.git arith.c (gfc_validate_kind): Add may_fail argument; abort if false and we don't validate the kind. * arith.c (gfc_validate_kind): Add may_fail argument; abort if false and we don't validate the kind. (gfc_check_integer_range, gfc_check_real_range): Update to match. * check.c (kind_check): Likewise. * decl.c (gfc_match_old_kind_spec, gfc_match_kind_spec): Likewise. (match_char_spec, match_logical_spec): Likewise. * gfortran.h (gfc_validate_kind): Likewise. * options.c (gfc_handle_option): Likewise. * primary.c (match_integer_constant, match_real_constant, match_string_constant, match_logical_constant, match_const_complex_part): Likewise. * simplify.c (get_kind, gfc_simplify_bit_size, gfc_simplify_digits, gfc_simplify_epsilon, gfc_simplify_huge, gfc_simplify_ibclr, gfc_simplify_ibset, gfc_simplify_ishft, gfc_simplify_ishftc, gfc_simplify_maxexponent, gfc_simplify_minexponent, gfc_simplify_nearest, gfc_simplify_not, gfc_simplify_precision, gfc_simplify_radix, gfc_simplify_range, gfc_simplify_rrspacing, gfc_simplify_scale, gfc_simplify_spacing, gfc_simplify_tan, gfc_simplify_tiny): Likewise. * trans-intrinsic.c (gfc_conv_intrinsic_aint, gfc_conv_intrinsic_mod, gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval, prepare_arg_info): Likewise. From-SVN: r86608 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 832c0457ace..9e727ca7a0b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,28 @@ +2004-08-25 Richard Henderson + + * arith.c (gfc_validate_kind): Add may_fail argument; abort if + false and we don't validate the kind. + (gfc_check_integer_range, gfc_check_real_range): Update to match. + * check.c (kind_check): Likewise. + * decl.c (gfc_match_old_kind_spec, gfc_match_kind_spec): Likewise. + (match_char_spec, match_logical_spec): Likewise. + * gfortran.h (gfc_validate_kind): Likewise. + * options.c (gfc_handle_option): Likewise. + * primary.c (match_integer_constant, match_real_constant, + match_string_constant, match_logical_constant, + match_const_complex_part): Likewise. + * simplify.c (get_kind, gfc_simplify_bit_size, gfc_simplify_digits, + gfc_simplify_epsilon, gfc_simplify_huge, gfc_simplify_ibclr, + gfc_simplify_ibset, gfc_simplify_ishft, gfc_simplify_ishftc, + gfc_simplify_maxexponent, gfc_simplify_minexponent, + gfc_simplify_nearest, gfc_simplify_not, gfc_simplify_precision, + gfc_simplify_radix, gfc_simplify_range, gfc_simplify_rrspacing, + gfc_simplify_scale, gfc_simplify_spacing, gfc_simplify_tan, + gfc_simplify_tiny): Likewise. + * trans-intrinsic.c (gfc_conv_intrinsic_aint, gfc_conv_intrinsic_mod, + gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval, + prepare_arg_info): Likewise. + 2004-08-25 Tobias Schlueter * expr.c (gfc_check_assign): Add comment. Add new warning. diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 5f558139401..ec19682df62 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -526,7 +526,7 @@ validate_character (int kind) type. */ int -gfc_validate_kind (bt type, int kind) +gfc_validate_kind (bt type, int kind, bool may_fail) { int rc; @@ -550,6 +550,9 @@ gfc_validate_kind (bt type, int kind) gfc_internal_error ("gfc_validate_kind(): Got bad type"); } + if (!may_fail && rc < 0) + gfc_internal_error ("gfc_validate_kind(): Got bad kind"); + return rc; } @@ -563,10 +566,7 @@ gfc_check_integer_range (mpz_t p, int kind) arith result; int i; - i = validate_integer (kind); - if (i == -1) - gfc_internal_error ("gfc_check_integer_range(): Bad kind"); - + i = gfc_validate_kind (BT_INTEGER, kind, false); result = ARITH_OK; if (mpz_cmp (p, gfc_integer_kinds[i].min_int) < 0 @@ -588,9 +588,7 @@ gfc_check_real_range (mpfr_t p, int kind) mpfr_t q; int i; - i = validate_real (kind); - if (i == -1) - gfc_internal_error ("gfc_check_real_range(): Bad kind"); + i = gfc_validate_kind (BT_REAL, kind, false); gfc_set_model (p); mpfr_init (q); diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 9e5906a985e..acf16c5362a 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -117,7 +117,7 @@ kind_check (gfc_expr * k, int n, bt type) } if (gfc_extract_int (k, &kind) != NULL - || gfc_validate_kind (type, kind) == -1) + || gfc_validate_kind (type, kind, true) < 0) { gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type), &k->where); @@ -133,7 +133,6 @@ kind_check (gfc_expr * k, int n, bt type) static try double_check (gfc_expr * d, int n) { - if (type_check (d, n, BT_REAL) == FAILURE) return FAILURE; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index e00a614cd06..3a61fda8a12 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -632,7 +632,7 @@ gfc_match_old_kind_spec (gfc_typespec * ts) if (ts->type == BT_COMPLEX && ts->kind == 16) ts->kind = 8; - if (gfc_validate_kind (ts->type, ts->kind) == -1) + if (gfc_validate_kind (ts->type, ts->kind, true) < 0) { gfc_error ("Old-style kind %d not supported for type %s at %C", ts->kind, gfc_basic_typename (ts->type)); @@ -692,7 +692,7 @@ gfc_match_kind_spec (gfc_typespec * ts) gfc_free_expr (e); e = NULL; - if (gfc_validate_kind (ts->type, ts->kind) == -1) + if (gfc_validate_kind (ts->type, ts->kind, true) < 0) { gfc_error ("Kind %d not supported for type %s at %C", ts->kind, gfc_basic_typename (ts->type)); @@ -790,7 +790,7 @@ match_char_spec (gfc_typespec * ts) gfc_match_small_int (&kind); - if (gfc_validate_kind (BT_CHARACTER, kind) == -1) + if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0) { gfc_error ("Kind %d is not a CHARACTER kind at %C", kind); return MATCH_YES; @@ -833,7 +833,7 @@ syntax: m = MATCH_ERROR; done: - if (m == MATCH_YES && gfc_validate_kind (BT_CHARACTER, kind) == -1) + if (m == MATCH_YES && gfc_validate_kind (BT_CHARACTER, kind, true) < 0) { gfc_error ("Kind %d is not a CHARACTER kind at %C", kind); m = MATCH_ERROR; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index e33a0aac710..d9da8057bae 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1511,7 +1511,7 @@ int gfc_default_double_kind (void); int gfc_default_character_kind (void); int gfc_default_logical_kind (void); int gfc_default_complex_kind (void); -int gfc_validate_kind (bt, int); +int gfc_validate_kind (bt, int, bool); extern int gfc_index_integer_kind; /* symbol.c */ diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 8432f5e6baa..83ca9c75548 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -282,7 +282,7 @@ gfc_handle_option (size_t scode, const char *arg, int value) break; case OPT_qkind_: - if (gfc_validate_kind (BT_REAL, value) < 0) + if (gfc_validate_kind (BT_REAL, value, true) < 0) gfc_fatal_error ("Argument to -fqkind isn't a valid real kind"); gfc_option.q_kind = value; break; diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index eb5dc337f1d..7cc99661d22 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -208,7 +208,7 @@ match_integer_constant (gfc_expr ** result, int signflag) if (kind == -1) return MATCH_ERROR; - if (gfc_validate_kind (BT_INTEGER, kind) == -1) + if (gfc_validate_kind (BT_INTEGER, kind, true) < 0) { gfc_error ("Integer kind %d at %C not available", kind); return MATCH_ERROR; @@ -477,7 +477,7 @@ done: if (kind == -2) kind = gfc_default_real_kind (); - if (gfc_validate_kind (BT_REAL, kind) == -1) + if (gfc_validate_kind (BT_REAL, kind, true) < 0) { gfc_error ("Invalid real kind %d at %C", kind); goto cleanup; @@ -818,7 +818,7 @@ match_string_constant (gfc_expr ** result) } } - if (gfc_validate_kind (BT_CHARACTER, kind) == -1) + if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0) { gfc_error ("Invalid kind %d for CHARACTER constant at %C", kind); return MATCH_ERROR; @@ -907,7 +907,7 @@ match_logical_constant (gfc_expr ** result) if (kind == -2) kind = gfc_default_logical_kind (); - if (gfc_validate_kind (BT_LOGICAL, kind) == -1) + if (gfc_validate_kind (BT_LOGICAL, kind, true) < 0) gfc_error ("Bad kind for logical constant at %C"); e = gfc_get_expr (); @@ -1120,7 +1120,7 @@ done: kind = gfc_default_real_kind (); } - if (gfc_validate_kind (BT_REAL, kind) == -1) + if (gfc_validate_kind (BT_REAL, kind, true) < 0) { gfc_error ("Invalid real kind %d at %C", kind); return MATCH_ERROR; diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index bffda5973df..e2a4f07c39b 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -128,7 +128,7 @@ get_kind (bt type, gfc_expr * k, const char *name, int default_kind) } if (gfc_extract_int (k, &kind) != NULL - || gfc_validate_kind (type, kind) == -1) + || gfc_validate_kind (type, kind, true) < 0) { gfc_error ("Invalid KIND parameter of %s at %L", name, &k->where); @@ -547,10 +547,7 @@ gfc_simplify_bit_size (gfc_expr * e) gfc_expr *result; int i; - i = gfc_validate_kind (e->ts.type, e->ts.kind); - if (i == -1) - gfc_internal_error ("In gfc_simplify_bit_size(): Bad kind"); - + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); result = gfc_constant_result (BT_INTEGER, e->ts.kind, &e->where); mpz_set_ui (result->value.integer, gfc_integer_kinds[i].bit_size); @@ -818,10 +815,7 @@ gfc_simplify_digits (gfc_expr * x) { int i, digits; - i = gfc_validate_kind (x->ts.type, x->ts.kind); - if (i == -1) - goto bad; - + i = gfc_validate_kind (x->ts.type, x->ts.kind, false); switch (x->ts.type) { case BT_INTEGER: @@ -834,8 +828,7 @@ gfc_simplify_digits (gfc_expr * x) break; default: - bad: - gfc_internal_error ("gfc_simplify_digits(): Bad type"); + abort (); } return gfc_int_expr (digits); @@ -907,9 +900,7 @@ gfc_simplify_epsilon (gfc_expr * e) gfc_expr *result; int i; - i = gfc_validate_kind (e->ts.type, e->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_epsilon(): Bad kind"); + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); @@ -1109,9 +1100,7 @@ gfc_simplify_huge (gfc_expr * e) gfc_expr *result; int i; - i = gfc_validate_kind (e->ts.type, e->ts.kind); - if (i == -1) - goto bad_type; + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where); @@ -1125,9 +1114,8 @@ gfc_simplify_huge (gfc_expr * e) mpfr_set (result->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE); break; - bad_type: default: - gfc_internal_error ("gfc_simplify_huge(): Bad type"); + abort (); } return result; @@ -1189,9 +1177,7 @@ gfc_simplify_ibclr (gfc_expr * x, gfc_expr * y) return &gfc_bad_expr; } - k = gfc_validate_kind (x->ts.type, x->ts.kind); - if (k == -1) - gfc_internal_error ("gfc_simplify_ibclr(): Bad kind"); + k = gfc_validate_kind (x->ts.type, x->ts.kind, false); if (pos > gfc_integer_kinds[k].bit_size) { @@ -1232,9 +1218,7 @@ gfc_simplify_ibits (gfc_expr * x, gfc_expr * y, gfc_expr * z) return &gfc_bad_expr; } - k = gfc_validate_kind (BT_INTEGER, x->ts.kind); - if (k == -1) - gfc_internal_error ("gfc_simplify_ibits(): Bad kind"); + k = gfc_validate_kind (BT_INTEGER, x->ts.kind, false); bitsize = gfc_integer_kinds[k].bit_size; @@ -1293,9 +1277,7 @@ gfc_simplify_ibset (gfc_expr * x, gfc_expr * y) return &gfc_bad_expr; } - k = gfc_validate_kind (x->ts.type, x->ts.kind); - if (k == -1) - gfc_internal_error ("gfc_simplify_ibset(): Bad kind"); + k = gfc_validate_kind (x->ts.type, x->ts.kind, false); if (pos > gfc_integer_kinds[k].bit_size) { @@ -1620,9 +1602,7 @@ gfc_simplify_ishft (gfc_expr * e, gfc_expr * s) return &gfc_bad_expr; } - k = gfc_validate_kind (BT_INTEGER, e->ts.kind); - if (k == -1) - gfc_internal_error ("gfc_simplify_ishft(): Bad kind"); + k = gfc_validate_kind (BT_INTEGER, e->ts.kind, false); isize = gfc_integer_kinds[k].bit_size; @@ -1676,9 +1656,7 @@ gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz) return &gfc_bad_expr; } - k = gfc_validate_kind (e->ts.type, e->ts.kind); - if (k == -1) - gfc_internal_error ("gfc_simplify_ishftc(): Bad kind"); + k = gfc_validate_kind (e->ts.type, e->ts.kind, false); if (sz != NULL) { @@ -2137,9 +2115,7 @@ gfc_simplify_maxexponent (gfc_expr * x) gfc_expr *result; int i; - i = gfc_validate_kind (BT_REAL, x->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_maxexponent(): Bad kind"); + i = gfc_validate_kind (BT_REAL, x->ts.kind, false); result = gfc_int_expr (gfc_real_kinds[i].max_exponent); result->where = x->where; @@ -2154,9 +2130,7 @@ gfc_simplify_minexponent (gfc_expr * x) gfc_expr *result; int i; - i = gfc_validate_kind (BT_REAL, x->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_minexponent(): Bad kind"); + i = gfc_validate_kind (BT_REAL, x->ts.kind, false); result = gfc_int_expr (gfc_real_kinds[i].min_exponent); result->where = x->where; @@ -2306,9 +2280,7 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) if (x->expr_type != EXPR_CONSTANT) return NULL; - k = gfc_validate_kind (x->ts.type, x->ts.kind); - if (k == -1) - gfc_internal_error ("gfc_simplify_precision(): Bad kind"); + k = gfc_validate_kind (x->ts.type, x->ts.kind, false); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); @@ -2443,9 +2415,7 @@ gfc_simplify_not (gfc_expr * e) /* Because of how GMP handles numbers, the result must be ANDed with the max_int mask. For radices <> 2, this will require change. */ - i = gfc_validate_kind (BT_INTEGER, e->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_not(): Bad kind"); + i = gfc_validate_kind (BT_INTEGER, e->ts.kind, false); mpz_and (result->value.integer, result->value.integer, gfc_integer_kinds[i].max_int); @@ -2480,9 +2450,7 @@ gfc_simplify_precision (gfc_expr * e) gfc_expr *result; int i; - i = gfc_validate_kind (e->ts.type, e->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_precision(): Bad kind"); + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); result = gfc_int_expr (gfc_real_kinds[i].precision); result->where = e->where; @@ -2497,10 +2465,7 @@ gfc_simplify_radix (gfc_expr * e) gfc_expr *result; int i; - i = gfc_validate_kind (e->ts.type, e->ts.kind); - if (i == -1) - goto bad; - + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); switch (e->ts.type) { case BT_INTEGER: @@ -2512,8 +2477,7 @@ gfc_simplify_radix (gfc_expr * e) break; default: - bad: - gfc_internal_error ("gfc_simplify_radix(): Bad type"); + abort (); } result = gfc_int_expr (i); @@ -2530,9 +2494,7 @@ gfc_simplify_range (gfc_expr * e) int i; long j; - i = gfc_validate_kind (e->ts.type, e->ts.kind); - if (i == -1) - goto bad_type; + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); switch (e->ts.type) { @@ -2545,9 +2507,8 @@ gfc_simplify_range (gfc_expr * e) j = gfc_real_kinds[i].range; break; - bad_type: default: - gfc_internal_error ("gfc_simplify_range(): Bad kind"); + abort (); } result = gfc_int_expr (j); @@ -2886,9 +2847,7 @@ gfc_simplify_rrspacing (gfc_expr * x) if (x->expr_type != EXPR_CONSTANT) return NULL; - i = gfc_validate_kind (x->ts.type, x->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_rrspacing(): Bad kind"); + i = gfc_validate_kind (x->ts.type, x->ts.kind, false); result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); @@ -2959,9 +2918,7 @@ gfc_simplify_scale (gfc_expr * x, gfc_expr * i) return result; } - k = gfc_validate_kind (BT_REAL, x->ts.kind); - if (k == -1) - gfc_internal_error ("gfc_simplify_scale(): Bad kind"); + k = gfc_validate_kind (BT_REAL, x->ts.kind, false); exp_range = gfc_real_kinds[k].max_exponent - gfc_real_kinds[k].min_exponent; @@ -3410,9 +3367,7 @@ gfc_simplify_spacing (gfc_expr * x) if (x->expr_type != EXPR_CONSTANT) return NULL; - i = gfc_validate_kind (x->ts.type, x->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_spacing(): Bad kind"); + i = gfc_validate_kind (x->ts.type, x->ts.kind, false); p = gfc_real_kinds[i].digits; @@ -3599,9 +3554,7 @@ gfc_simplify_tan (gfc_expr * x) if (x->expr_type != EXPR_CONSTANT) return NULL; - i = gfc_validate_kind (BT_REAL, x->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_tan(): Bad kind"); + i = gfc_validate_kind (BT_REAL, x->ts.kind, false); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); @@ -3634,9 +3587,7 @@ gfc_simplify_tiny (gfc_expr * e) gfc_expr *result; int i; - i = gfc_validate_kind (BT_REAL, e->ts.kind); - if (i == -1) - gfc_internal_error ("gfc_simplify_error(): Bad kind"); + i = gfc_validate_kind (BT_REAL, e->ts.kind, false); result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index cfcbd2fb13d..396a3da6bb8 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -365,7 +365,7 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, int op) /* Test if the value is too large to handle sensibly. */ gfc_set_model_kind (kind); mpfr_init (huge); - n = gfc_validate_kind (BT_INTEGER, kind); + n = gfc_validate_kind (BT_INTEGER, kind, false); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); tmp = gfc_conv_mpfr_to_tree (huge, kind); cond = build2 (LT_EXPR, boolean_type_node, arg, tmp); @@ -804,7 +804,7 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) /* Test if the value is too large to handle sensibly. */ gfc_set_model_kind (expr->ts.kind); mpfr_init (huge); - n = gfc_validate_kind (BT_INTEGER, expr->ts.kind); + n = gfc_validate_kind (BT_INTEGER, expr->ts.kind, false); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); test2 = build2 (LT_EXPR, boolean_type_node, tmp, test); @@ -1424,7 +1424,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) maskss = NULL; limit = gfc_create_var (gfc_typenode_for_spec (&arrayexpr->ts), "limit"); - n = gfc_validate_kind (arrayexpr->ts.type, arrayexpr->ts.kind); + n = gfc_validate_kind (arrayexpr->ts.type, arrayexpr->ts.kind, false); switch (arrayexpr->ts.type) { case BT_REAL: @@ -1565,7 +1565,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op) type = gfc_typenode_for_spec (&expr->ts); /* Initialize the result. */ limit = gfc_create_var (type, "limit"); - n = gfc_validate_kind (expr->ts.type, expr->ts.kind); + n = gfc_validate_kind (expr->ts.type, expr->ts.kind, false); switch (expr->ts.type) { case BT_REAL: @@ -2327,7 +2327,7 @@ void prepare_arg_info (gfc_se * se, gfc_expr * expr, rcs->arg = arg; /* Caculate the numbers of bits of exponent, fraction and word */ - n = gfc_validate_kind (a1->ts.type, a1->ts.kind); + n = gfc_validate_kind (a1->ts.type, a1->ts.kind, false); tmp = build_int_cst (NULL_TREE, gfc_real_kinds[n].digits - 1); rcs->fdigits = convert (masktype, tmp); wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1);