Commit e7a2d5fb by Richard Henderson Committed by Richard Henderson

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
parent 1249691b
2004-08-25 Richard Henderson <rth@redhat.com>
* 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 <tobias.schlueter@physik.uni-muenchen.de> 2004-08-25 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* expr.c (gfc_check_assign): Add comment. Add new warning. * expr.c (gfc_check_assign): Add comment. Add new warning.
......
...@@ -526,7 +526,7 @@ validate_character (int kind) ...@@ -526,7 +526,7 @@ validate_character (int kind)
type. */ type. */
int int
gfc_validate_kind (bt type, int kind) gfc_validate_kind (bt type, int kind, bool may_fail)
{ {
int rc; int rc;
...@@ -550,6 +550,9 @@ gfc_validate_kind (bt type, int kind) ...@@ -550,6 +550,9 @@ gfc_validate_kind (bt type, int kind)
gfc_internal_error ("gfc_validate_kind(): Got bad type"); 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; return rc;
} }
...@@ -563,10 +566,7 @@ gfc_check_integer_range (mpz_t p, int kind) ...@@ -563,10 +566,7 @@ gfc_check_integer_range (mpz_t p, int kind)
arith result; arith result;
int i; int i;
i = validate_integer (kind); i = gfc_validate_kind (BT_INTEGER, kind, false);
if (i == -1)
gfc_internal_error ("gfc_check_integer_range(): Bad kind");
result = ARITH_OK; result = ARITH_OK;
if (mpz_cmp (p, gfc_integer_kinds[i].min_int) < 0 if (mpz_cmp (p, gfc_integer_kinds[i].min_int) < 0
...@@ -588,9 +588,7 @@ gfc_check_real_range (mpfr_t p, int kind) ...@@ -588,9 +588,7 @@ gfc_check_real_range (mpfr_t p, int kind)
mpfr_t q; mpfr_t q;
int i; int i;
i = validate_real (kind); i = gfc_validate_kind (BT_REAL, kind, false);
if (i == -1)
gfc_internal_error ("gfc_check_real_range(): Bad kind");
gfc_set_model (p); gfc_set_model (p);
mpfr_init (q); mpfr_init (q);
......
...@@ -117,7 +117,7 @@ kind_check (gfc_expr * k, int n, bt type) ...@@ -117,7 +117,7 @@ kind_check (gfc_expr * k, int n, bt type)
} }
if (gfc_extract_int (k, &kind) != NULL 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), gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type),
&k->where); &k->where);
...@@ -133,7 +133,6 @@ kind_check (gfc_expr * k, int n, bt type) ...@@ -133,7 +133,6 @@ kind_check (gfc_expr * k, int n, bt type)
static try static try
double_check (gfc_expr * d, int n) double_check (gfc_expr * d, int n)
{ {
if (type_check (d, n, BT_REAL) == FAILURE) if (type_check (d, n, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
......
...@@ -632,7 +632,7 @@ gfc_match_old_kind_spec (gfc_typespec * ts) ...@@ -632,7 +632,7 @@ gfc_match_old_kind_spec (gfc_typespec * ts)
if (ts->type == BT_COMPLEX && ts->kind == 16) if (ts->type == BT_COMPLEX && ts->kind == 16)
ts->kind = 8; 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", gfc_error ("Old-style kind %d not supported for type %s at %C",
ts->kind, gfc_basic_typename (ts->type)); ts->kind, gfc_basic_typename (ts->type));
...@@ -692,7 +692,7 @@ gfc_match_kind_spec (gfc_typespec * ts) ...@@ -692,7 +692,7 @@ gfc_match_kind_spec (gfc_typespec * ts)
gfc_free_expr (e); gfc_free_expr (e);
e = NULL; 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_error ("Kind %d not supported for type %s at %C", ts->kind,
gfc_basic_typename (ts->type)); gfc_basic_typename (ts->type));
...@@ -790,7 +790,7 @@ match_char_spec (gfc_typespec * ts) ...@@ -790,7 +790,7 @@ match_char_spec (gfc_typespec * ts)
gfc_match_small_int (&kind); 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); gfc_error ("Kind %d is not a CHARACTER kind at %C", kind);
return MATCH_YES; return MATCH_YES;
...@@ -833,7 +833,7 @@ syntax: ...@@ -833,7 +833,7 @@ syntax:
m = MATCH_ERROR; m = MATCH_ERROR;
done: 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); gfc_error ("Kind %d is not a CHARACTER kind at %C", kind);
m = MATCH_ERROR; m = MATCH_ERROR;
......
...@@ -1511,7 +1511,7 @@ int gfc_default_double_kind (void); ...@@ -1511,7 +1511,7 @@ int gfc_default_double_kind (void);
int gfc_default_character_kind (void); int gfc_default_character_kind (void);
int gfc_default_logical_kind (void); int gfc_default_logical_kind (void);
int gfc_default_complex_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; extern int gfc_index_integer_kind;
/* symbol.c */ /* symbol.c */
......
...@@ -282,7 +282,7 @@ gfc_handle_option (size_t scode, const char *arg, int value) ...@@ -282,7 +282,7 @@ gfc_handle_option (size_t scode, const char *arg, int value)
break; break;
case OPT_qkind_: 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_fatal_error ("Argument to -fqkind isn't a valid real kind");
gfc_option.q_kind = value; gfc_option.q_kind = value;
break; break;
......
...@@ -208,7 +208,7 @@ match_integer_constant (gfc_expr ** result, int signflag) ...@@ -208,7 +208,7 @@ match_integer_constant (gfc_expr ** result, int signflag)
if (kind == -1) if (kind == -1)
return MATCH_ERROR; 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); gfc_error ("Integer kind %d at %C not available", kind);
return MATCH_ERROR; return MATCH_ERROR;
...@@ -477,7 +477,7 @@ done: ...@@ -477,7 +477,7 @@ done:
if (kind == -2) if (kind == -2)
kind = gfc_default_real_kind (); 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); gfc_error ("Invalid real kind %d at %C", kind);
goto cleanup; goto cleanup;
...@@ -818,7 +818,7 @@ match_string_constant (gfc_expr ** result) ...@@ -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); gfc_error ("Invalid kind %d for CHARACTER constant at %C", kind);
return MATCH_ERROR; return MATCH_ERROR;
...@@ -907,7 +907,7 @@ match_logical_constant (gfc_expr ** result) ...@@ -907,7 +907,7 @@ match_logical_constant (gfc_expr ** result)
if (kind == -2) if (kind == -2)
kind = gfc_default_logical_kind (); 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"); gfc_error ("Bad kind for logical constant at %C");
e = gfc_get_expr (); e = gfc_get_expr ();
...@@ -1120,7 +1120,7 @@ done: ...@@ -1120,7 +1120,7 @@ done:
kind = gfc_default_real_kind (); 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); gfc_error ("Invalid real kind %d at %C", kind);
return MATCH_ERROR; return MATCH_ERROR;
......
...@@ -128,7 +128,7 @@ get_kind (bt type, gfc_expr * k, const char *name, int default_kind) ...@@ -128,7 +128,7 @@ get_kind (bt type, gfc_expr * k, const char *name, int default_kind)
} }
if (gfc_extract_int (k, &kind) != NULL 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); gfc_error ("Invalid KIND parameter of %s at %L", name, &k->where);
...@@ -547,10 +547,7 @@ gfc_simplify_bit_size (gfc_expr * e) ...@@ -547,10 +547,7 @@ gfc_simplify_bit_size (gfc_expr * e)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (e->ts.type, e->ts.kind); i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
if (i == -1)
gfc_internal_error ("In gfc_simplify_bit_size(): Bad kind");
result = gfc_constant_result (BT_INTEGER, e->ts.kind, &e->where); result = gfc_constant_result (BT_INTEGER, e->ts.kind, &e->where);
mpz_set_ui (result->value.integer, gfc_integer_kinds[i].bit_size); mpz_set_ui (result->value.integer, gfc_integer_kinds[i].bit_size);
...@@ -818,10 +815,7 @@ gfc_simplify_digits (gfc_expr * x) ...@@ -818,10 +815,7 @@ gfc_simplify_digits (gfc_expr * x)
{ {
int i, digits; int i, digits;
i = gfc_validate_kind (x->ts.type, x->ts.kind); i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
if (i == -1)
goto bad;
switch (x->ts.type) switch (x->ts.type)
{ {
case BT_INTEGER: case BT_INTEGER:
...@@ -834,8 +828,7 @@ gfc_simplify_digits (gfc_expr * x) ...@@ -834,8 +828,7 @@ gfc_simplify_digits (gfc_expr * x)
break; break;
default: default:
bad: abort ();
gfc_internal_error ("gfc_simplify_digits(): Bad type");
} }
return gfc_int_expr (digits); return gfc_int_expr (digits);
...@@ -907,9 +900,7 @@ gfc_simplify_epsilon (gfc_expr * e) ...@@ -907,9 +900,7 @@ gfc_simplify_epsilon (gfc_expr * e)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (e->ts.type, e->ts.kind); i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_epsilon(): Bad kind");
result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where);
...@@ -1109,9 +1100,7 @@ gfc_simplify_huge (gfc_expr * e) ...@@ -1109,9 +1100,7 @@ gfc_simplify_huge (gfc_expr * e)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (e->ts.type, e->ts.kind); i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
if (i == -1)
goto bad_type;
result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where); result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where);
...@@ -1125,9 +1114,8 @@ gfc_simplify_huge (gfc_expr * e) ...@@ -1125,9 +1114,8 @@ gfc_simplify_huge (gfc_expr * e)
mpfr_set (result->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE); mpfr_set (result->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE);
break; break;
bad_type:
default: default:
gfc_internal_error ("gfc_simplify_huge(): Bad type"); abort ();
} }
return result; return result;
...@@ -1189,9 +1177,7 @@ gfc_simplify_ibclr (gfc_expr * x, gfc_expr * y) ...@@ -1189,9 +1177,7 @@ gfc_simplify_ibclr (gfc_expr * x, gfc_expr * y)
return &gfc_bad_expr; return &gfc_bad_expr;
} }
k = gfc_validate_kind (x->ts.type, x->ts.kind); k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
if (k == -1)
gfc_internal_error ("gfc_simplify_ibclr(): Bad kind");
if (pos > gfc_integer_kinds[k].bit_size) if (pos > gfc_integer_kinds[k].bit_size)
{ {
...@@ -1232,9 +1218,7 @@ gfc_simplify_ibits (gfc_expr * x, gfc_expr * y, gfc_expr * z) ...@@ -1232,9 +1218,7 @@ gfc_simplify_ibits (gfc_expr * x, gfc_expr * y, gfc_expr * z)
return &gfc_bad_expr; return &gfc_bad_expr;
} }
k = gfc_validate_kind (BT_INTEGER, x->ts.kind); k = gfc_validate_kind (BT_INTEGER, x->ts.kind, false);
if (k == -1)
gfc_internal_error ("gfc_simplify_ibits(): Bad kind");
bitsize = gfc_integer_kinds[k].bit_size; bitsize = gfc_integer_kinds[k].bit_size;
...@@ -1293,9 +1277,7 @@ gfc_simplify_ibset (gfc_expr * x, gfc_expr * y) ...@@ -1293,9 +1277,7 @@ gfc_simplify_ibset (gfc_expr * x, gfc_expr * y)
return &gfc_bad_expr; return &gfc_bad_expr;
} }
k = gfc_validate_kind (x->ts.type, x->ts.kind); k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
if (k == -1)
gfc_internal_error ("gfc_simplify_ibset(): Bad kind");
if (pos > gfc_integer_kinds[k].bit_size) if (pos > gfc_integer_kinds[k].bit_size)
{ {
...@@ -1620,9 +1602,7 @@ gfc_simplify_ishft (gfc_expr * e, gfc_expr * s) ...@@ -1620,9 +1602,7 @@ gfc_simplify_ishft (gfc_expr * e, gfc_expr * s)
return &gfc_bad_expr; return &gfc_bad_expr;
} }
k = gfc_validate_kind (BT_INTEGER, e->ts.kind); k = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
if (k == -1)
gfc_internal_error ("gfc_simplify_ishft(): Bad kind");
isize = gfc_integer_kinds[k].bit_size; isize = gfc_integer_kinds[k].bit_size;
...@@ -1676,9 +1656,7 @@ gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz) ...@@ -1676,9 +1656,7 @@ gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz)
return &gfc_bad_expr; return &gfc_bad_expr;
} }
k = gfc_validate_kind (e->ts.type, e->ts.kind); k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
if (k == -1)
gfc_internal_error ("gfc_simplify_ishftc(): Bad kind");
if (sz != NULL) if (sz != NULL)
{ {
...@@ -2137,9 +2115,7 @@ gfc_simplify_maxexponent (gfc_expr * x) ...@@ -2137,9 +2115,7 @@ gfc_simplify_maxexponent (gfc_expr * x)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (BT_REAL, x->ts.kind); i = gfc_validate_kind (BT_REAL, x->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_maxexponent(): Bad kind");
result = gfc_int_expr (gfc_real_kinds[i].max_exponent); result = gfc_int_expr (gfc_real_kinds[i].max_exponent);
result->where = x->where; result->where = x->where;
...@@ -2154,9 +2130,7 @@ gfc_simplify_minexponent (gfc_expr * x) ...@@ -2154,9 +2130,7 @@ gfc_simplify_minexponent (gfc_expr * x)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (BT_REAL, x->ts.kind); i = gfc_validate_kind (BT_REAL, x->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_minexponent(): Bad kind");
result = gfc_int_expr (gfc_real_kinds[i].min_exponent); result = gfc_int_expr (gfc_real_kinds[i].min_exponent);
result->where = x->where; result->where = x->where;
...@@ -2306,9 +2280,7 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) ...@@ -2306,9 +2280,7 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
k = gfc_validate_kind (x->ts.type, x->ts.kind); k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
if (k == -1)
gfc_internal_error ("gfc_simplify_precision(): Bad kind");
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
...@@ -2443,9 +2415,7 @@ gfc_simplify_not (gfc_expr * e) ...@@ -2443,9 +2415,7 @@ gfc_simplify_not (gfc_expr * e)
/* Because of how GMP handles numbers, the result must be ANDed with /* Because of how GMP handles numbers, the result must be ANDed with
the max_int mask. For radices <> 2, this will require change. */ the max_int mask. For radices <> 2, this will require change. */
i = gfc_validate_kind (BT_INTEGER, e->ts.kind); i = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_not(): Bad kind");
mpz_and (result->value.integer, result->value.integer, mpz_and (result->value.integer, result->value.integer,
gfc_integer_kinds[i].max_int); gfc_integer_kinds[i].max_int);
...@@ -2480,9 +2450,7 @@ gfc_simplify_precision (gfc_expr * e) ...@@ -2480,9 +2450,7 @@ gfc_simplify_precision (gfc_expr * e)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (e->ts.type, e->ts.kind); i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_precision(): Bad kind");
result = gfc_int_expr (gfc_real_kinds[i].precision); result = gfc_int_expr (gfc_real_kinds[i].precision);
result->where = e->where; result->where = e->where;
...@@ -2497,10 +2465,7 @@ gfc_simplify_radix (gfc_expr * e) ...@@ -2497,10 +2465,7 @@ gfc_simplify_radix (gfc_expr * e)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (e->ts.type, e->ts.kind); i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
if (i == -1)
goto bad;
switch (e->ts.type) switch (e->ts.type)
{ {
case BT_INTEGER: case BT_INTEGER:
...@@ -2512,8 +2477,7 @@ gfc_simplify_radix (gfc_expr * e) ...@@ -2512,8 +2477,7 @@ gfc_simplify_radix (gfc_expr * e)
break; break;
default: default:
bad: abort ();
gfc_internal_error ("gfc_simplify_radix(): Bad type");
} }
result = gfc_int_expr (i); result = gfc_int_expr (i);
...@@ -2530,9 +2494,7 @@ gfc_simplify_range (gfc_expr * e) ...@@ -2530,9 +2494,7 @@ gfc_simplify_range (gfc_expr * e)
int i; int i;
long j; long j;
i = gfc_validate_kind (e->ts.type, e->ts.kind); i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
if (i == -1)
goto bad_type;
switch (e->ts.type) switch (e->ts.type)
{ {
...@@ -2545,9 +2507,8 @@ gfc_simplify_range (gfc_expr * e) ...@@ -2545,9 +2507,8 @@ gfc_simplify_range (gfc_expr * e)
j = gfc_real_kinds[i].range; j = gfc_real_kinds[i].range;
break; break;
bad_type:
default: default:
gfc_internal_error ("gfc_simplify_range(): Bad kind"); abort ();
} }
result = gfc_int_expr (j); result = gfc_int_expr (j);
...@@ -2886,9 +2847,7 @@ gfc_simplify_rrspacing (gfc_expr * x) ...@@ -2886,9 +2847,7 @@ gfc_simplify_rrspacing (gfc_expr * x)
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
i = gfc_validate_kind (x->ts.type, x->ts.kind); i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_rrspacing(): Bad kind");
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
...@@ -2959,9 +2918,7 @@ gfc_simplify_scale (gfc_expr * x, gfc_expr * i) ...@@ -2959,9 +2918,7 @@ gfc_simplify_scale (gfc_expr * x, gfc_expr * i)
return result; return result;
} }
k = gfc_validate_kind (BT_REAL, x->ts.kind); k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
if (k == -1)
gfc_internal_error ("gfc_simplify_scale(): Bad kind");
exp_range = gfc_real_kinds[k].max_exponent - gfc_real_kinds[k].min_exponent; exp_range = gfc_real_kinds[k].max_exponent - gfc_real_kinds[k].min_exponent;
...@@ -3410,9 +3367,7 @@ gfc_simplify_spacing (gfc_expr * x) ...@@ -3410,9 +3367,7 @@ gfc_simplify_spacing (gfc_expr * x)
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
i = gfc_validate_kind (x->ts.type, x->ts.kind); i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_spacing(): Bad kind");
p = gfc_real_kinds[i].digits; p = gfc_real_kinds[i].digits;
...@@ -3599,9 +3554,7 @@ gfc_simplify_tan (gfc_expr * x) ...@@ -3599,9 +3554,7 @@ gfc_simplify_tan (gfc_expr * x)
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
i = gfc_validate_kind (BT_REAL, x->ts.kind); i = gfc_validate_kind (BT_REAL, x->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_tan(): Bad kind");
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
...@@ -3634,9 +3587,7 @@ gfc_simplify_tiny (gfc_expr * e) ...@@ -3634,9 +3587,7 @@ gfc_simplify_tiny (gfc_expr * e)
gfc_expr *result; gfc_expr *result;
int i; int i;
i = gfc_validate_kind (BT_REAL, e->ts.kind); i = gfc_validate_kind (BT_REAL, e->ts.kind, false);
if (i == -1)
gfc_internal_error ("gfc_simplify_error(): Bad kind");
result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where);
mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE); mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
......
...@@ -365,7 +365,7 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, int op) ...@@ -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. */ /* Test if the value is too large to handle sensibly. */
gfc_set_model_kind (kind); gfc_set_model_kind (kind);
mpfr_init (huge); 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); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
tmp = gfc_conv_mpfr_to_tree (huge, kind); tmp = gfc_conv_mpfr_to_tree (huge, kind);
cond = build2 (LT_EXPR, boolean_type_node, arg, tmp); 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) ...@@ -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. */ /* Test if the value is too large to handle sensibly. */
gfc_set_model_kind (expr->ts.kind); gfc_set_model_kind (expr->ts.kind);
mpfr_init (huge); 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); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind);
test2 = build2 (LT_EXPR, boolean_type_node, tmp, test); 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) ...@@ -1424,7 +1424,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
maskss = NULL; maskss = NULL;
limit = gfc_create_var (gfc_typenode_for_spec (&arrayexpr->ts), "limit"); 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) switch (arrayexpr->ts.type)
{ {
case BT_REAL: case BT_REAL:
...@@ -1565,7 +1565,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op) ...@@ -1565,7 +1565,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op)
type = gfc_typenode_for_spec (&expr->ts); type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */ /* Initialize the result. */
limit = gfc_create_var (type, "limit"); 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) switch (expr->ts.type)
{ {
case BT_REAL: case BT_REAL:
...@@ -2327,7 +2327,7 @@ void prepare_arg_info (gfc_se * se, gfc_expr * expr, ...@@ -2327,7 +2327,7 @@ void prepare_arg_info (gfc_se * se, gfc_expr * expr,
rcs->arg = arg; rcs->arg = arg;
/* Caculate the numbers of bits of exponent, fraction and word */ /* 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); tmp = build_int_cst (NULL_TREE, gfc_real_kinds[n].digits - 1);
rcs->fdigits = convert (masktype, tmp); rcs->fdigits = convert (masktype, tmp);
wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1); wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment