Commit 27dfc9c4 by Tobias Schlüter Committed by Tobias Schlüter

arith.c (arctangent2, [...]): Fix whitespace issues.

* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.

From-SVN: r93093
parent b36cd00b
...@@ -9,7 +9,44 @@ ...@@ -9,7 +9,44 @@
(prepare_arg_info): Fix formatting, indenting and remove trailing (prepare_arg_info): Fix formatting, indenting and remove trailing
whitespace. whitespace.
(gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_trim): Remove (gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_trim): Remove
trailing whitespace. trailing whitespace.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
2005-01-08 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> 2005-01-08 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
......
...@@ -92,7 +92,7 @@ arctangent2 (mpfr_t y, mpfr_t x, mpfr_t result) ...@@ -92,7 +92,7 @@ arctangent2 (mpfr_t y, mpfr_t x, mpfr_t result)
gfc_set_model (y); gfc_set_model (y);
mpfr_init (t); mpfr_init (t);
i = mpfr_sgn(x); i = mpfr_sgn (x);
if (i > 0) if (i > 0)
{ {
...@@ -206,12 +206,12 @@ gfc_arith_init_1 (void) ...@@ -206,12 +206,12 @@ gfc_arith_init_1 (void)
Standard Fortran requires integers to be symmetrical, i.e. Standard Fortran requires integers to be symmetrical, i.e.
every negative integer must have a representable positive every negative integer must have a representable positive
absolute value, and vice versa. */ absolute value, and vice versa. */
mpz_init (int_info->pedantic_min_int); mpz_init (int_info->pedantic_min_int);
mpz_neg (int_info->pedantic_min_int, int_info->huge); mpz_neg (int_info->pedantic_min_int, int_info->huge);
mpz_init (int_info->min_int); mpz_init (int_info->min_int);
mpz_sub_ui(int_info->min_int, int_info->pedantic_min_int, 1); mpz_sub_ui (int_info->min_int, int_info->pedantic_min_int, 1);
mpz_init (int_info->max_int); mpz_init (int_info->max_int);
mpz_add (int_info->max_int, int_info->huge, int_info->huge); mpz_add (int_info->max_int, int_info->huge, int_info->huge);
...@@ -330,7 +330,7 @@ gfc_arith_done_1 (void) ...@@ -330,7 +330,7 @@ gfc_arith_done_1 (void)
/* Given an integer and a kind, make sure that the integer lies within /* Given an integer and a kind, make sure that the integer lies within
the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or
ARITH_OVERFLOW. */ ARITH_OVERFLOW. */
static arith static arith
...@@ -396,7 +396,7 @@ done: ...@@ -396,7 +396,7 @@ done:
/* Function to return a constant expression node of a given type and /* Function to return a constant expression node of a given type and
kind. */ kind. */
gfc_expr * gfc_expr *
gfc_constant_result (bt type, int kind, locus * where) gfc_constant_result (bt type, int kind, locus * where)
{ {
gfc_expr *result; gfc_expr *result;
...@@ -549,7 +549,7 @@ gfc_range_check (gfc_expr * e) ...@@ -549,7 +549,7 @@ gfc_range_check (gfc_expr * e)
default: default:
gfc_internal_error ("gfc_range_check(): Bad type"); gfc_internal_error ("gfc_range_check(): Bad type");
} }
return rc; return rc;
} }
...@@ -1089,7 +1089,7 @@ gfc_arith_power (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1089,7 +1089,7 @@ gfc_arith_power (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
gfc_free_expr (result); gfc_free_expr (result);
else else
*resultp = result; *resultp = result;
return rc; return rc;
} }
...@@ -1687,9 +1687,9 @@ static gfc_expr * ...@@ -1687,9 +1687,9 @@ static gfc_expr *
eval_type_intrinsic0 (gfc_intrinsic_op operator, gfc_expr *op) eval_type_intrinsic0 (gfc_intrinsic_op operator, gfc_expr *op)
{ {
if (op == NULL) if (op == NULL)
gfc_internal_error("eval_type_intrinsic0(): op NULL"); gfc_internal_error ("eval_type_intrinsic0(): op NULL");
switch(operator) switch (operator)
{ {
case INTRINSIC_GE: case INTRINSIC_GE:
case INTRINSIC_LT: case INTRINSIC_LT:
...@@ -1755,13 +1755,13 @@ eval_intrinsic_f2 (gfc_intrinsic_op operator, ...@@ -1755,13 +1755,13 @@ eval_intrinsic_f2 (gfc_intrinsic_op operator,
if (op2 == NULL) if (op2 == NULL)
{ {
if (gfc_zero_size_array (op1)) if (gfc_zero_size_array (op1))
return eval_type_intrinsic0(operator, op1); return eval_type_intrinsic0 (operator, op1);
} }
else else
{ {
result = reduce_binary0 (op1, op2); result = reduce_binary0 (op1, op2);
if (result != NULL) if (result != NULL)
return eval_type_intrinsic0(operator, result); return eval_type_intrinsic0 (operator, result);
} }
f.f2 = eval; f.f2 = eval;
...@@ -2093,7 +2093,7 @@ gfc_real2real (gfc_expr * src, int kind) ...@@ -2093,7 +2093,7 @@ gfc_real2real (gfc_expr * src, int kind)
{ {
if (gfc_option.warn_underflow) if (gfc_option.warn_underflow)
gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
mpfr_set_ui(result->value.real, 0, GFC_RND_MODE); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
} }
else if (rc != ARITH_OK) else if (rc != ARITH_OK)
{ {
...@@ -2125,7 +2125,7 @@ gfc_real2complex (gfc_expr * src, int kind) ...@@ -2125,7 +2125,7 @@ gfc_real2complex (gfc_expr * src, int kind)
{ {
if (gfc_option.warn_underflow) if (gfc_option.warn_underflow)
gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
mpfr_set_ui(result->value.complex.r, 0, GFC_RND_MODE); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
} }
else if (rc != ARITH_OK) else if (rc != ARITH_OK)
{ {
...@@ -2148,7 +2148,7 @@ gfc_complex2int (gfc_expr * src, int kind) ...@@ -2148,7 +2148,7 @@ gfc_complex2int (gfc_expr * src, int kind)
result = gfc_constant_result (BT_INTEGER, kind, &src->where); result = gfc_constant_result (BT_INTEGER, kind, &src->where);
gfc_mpfr_to_mpz(result->value.integer, src->value.complex.r); gfc_mpfr_to_mpz (result->value.integer, src->value.complex.r);
if ((rc = gfc_check_integer_range (result->value.integer, kind)) if ((rc = gfc_check_integer_range (result->value.integer, kind))
!= ARITH_OK) != ARITH_OK)
...@@ -2176,11 +2176,11 @@ gfc_complex2real (gfc_expr * src, int kind) ...@@ -2176,11 +2176,11 @@ gfc_complex2real (gfc_expr * src, int kind)
rc = gfc_check_real_range (result->value.real, kind); rc = gfc_check_real_range (result->value.real, kind);
if (rc == ARITH_UNDERFLOW) if (rc == ARITH_UNDERFLOW)
{ {
if (gfc_option.warn_underflow) if (gfc_option.warn_underflow)
gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
mpfr_set_ui(result->value.real, 0, GFC_RND_MODE); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
} }
if (rc != ARITH_OK) if (rc != ARITH_OK)
{ {
...@@ -2212,7 +2212,7 @@ gfc_complex2complex (gfc_expr * src, int kind) ...@@ -2212,7 +2212,7 @@ gfc_complex2complex (gfc_expr * src, int kind)
{ {
if (gfc_option.warn_underflow) if (gfc_option.warn_underflow)
gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
mpfr_set_ui(result->value.complex.r, 0, GFC_RND_MODE); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
} }
else if (rc != ARITH_OK) else if (rc != ARITH_OK)
{ {
...@@ -2220,14 +2220,14 @@ gfc_complex2complex (gfc_expr * src, int kind) ...@@ -2220,14 +2220,14 @@ gfc_complex2complex (gfc_expr * src, int kind)
gfc_free_expr (result); gfc_free_expr (result);
return NULL; return NULL;
} }
rc = gfc_check_real_range (result->value.complex.i, kind); rc = gfc_check_real_range (result->value.complex.i, kind);
if (rc == ARITH_UNDERFLOW) if (rc == ARITH_UNDERFLOW)
{ {
if (gfc_option.warn_underflow) if (gfc_option.warn_underflow)
gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
mpfr_set_ui(result->value.complex.i, 0, GFC_RND_MODE); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
} }
else if (rc != ARITH_OK) else if (rc != ARITH_OK)
{ {
......
...@@ -39,7 +39,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA ...@@ -39,7 +39,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
static void static void
must_be (gfc_expr * e, int n, const char *thing) must_be (gfc_expr * e, int n, const char *thing)
{ {
gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s", gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s",
gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where, gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where,
thing); thing);
...@@ -51,7 +50,6 @@ must_be (gfc_expr * e, int n, const char *thing) ...@@ -51,7 +50,6 @@ must_be (gfc_expr * e, int n, const char *thing)
static try static try
type_check (gfc_expr * e, int n, bt type) type_check (gfc_expr * e, int n, bt type)
{ {
if (e->ts.type == type) if (e->ts.type == type)
return SUCCESS; return SUCCESS;
...@@ -66,7 +64,6 @@ type_check (gfc_expr * e, int n, bt type) ...@@ -66,7 +64,6 @@ type_check (gfc_expr * e, int n, bt type)
static try static try
numeric_check (gfc_expr * e, int n) numeric_check (gfc_expr * e, int n)
{ {
if (gfc_numeric_ts (&e->ts)) if (gfc_numeric_ts (&e->ts))
return SUCCESS; return SUCCESS;
...@@ -81,7 +78,6 @@ numeric_check (gfc_expr * e, int n) ...@@ -81,7 +78,6 @@ numeric_check (gfc_expr * e, int n)
static try static try
int_or_real_check (gfc_expr * e, int n) int_or_real_check (gfc_expr * e, int n)
{ {
if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL) if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
{ {
must_be (e, n, "INTEGER or REAL"); must_be (e, n, "INTEGER or REAL");
...@@ -147,7 +143,6 @@ double_check (gfc_expr * d, int n) ...@@ -147,7 +143,6 @@ double_check (gfc_expr * d, int n)
static try static try
logical_array_check (gfc_expr * array, int n) logical_array_check (gfc_expr * array, int n)
{ {
if (array->ts.type != BT_LOGICAL || array->rank == 0) if (array->ts.type != BT_LOGICAL || array->rank == 0)
{ {
must_be (array, n, "a logical array"); must_be (array, n, "a logical array");
...@@ -163,7 +158,6 @@ logical_array_check (gfc_expr * array, int n) ...@@ -163,7 +158,6 @@ logical_array_check (gfc_expr * array, int n)
static try static try
array_check (gfc_expr * e, int n) array_check (gfc_expr * e, int n)
{ {
if (e->rank != 0) if (e->rank != 0)
return SUCCESS; return SUCCESS;
...@@ -178,7 +172,6 @@ array_check (gfc_expr * e, int n) ...@@ -178,7 +172,6 @@ array_check (gfc_expr * e, int n)
static try static try
scalar_check (gfc_expr * e, int n) scalar_check (gfc_expr * e, int n)
{ {
if (e->rank == 0) if (e->rank == 0)
return SUCCESS; return SUCCESS;
...@@ -230,7 +223,6 @@ rank_check (gfc_expr * e, int n, int rank) ...@@ -230,7 +223,6 @@ rank_check (gfc_expr * e, int n, int rank)
static try static try
nonoptional_check (gfc_expr * e, int n) nonoptional_check (gfc_expr * e, int n)
{ {
if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional) if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional)
{ {
gfc_error ("'%s' argument of '%s' intrinsic at %L must not be OPTIONAL", gfc_error ("'%s' argument of '%s' intrinsic at %L must not be OPTIONAL",
...@@ -267,7 +259,6 @@ kind_value_check (gfc_expr * e, int n, int k) ...@@ -267,7 +259,6 @@ kind_value_check (gfc_expr * e, int n, int k)
static try static try
variable_check (gfc_expr * e, int n) variable_check (gfc_expr * e, int n)
{ {
if ((e->expr_type == EXPR_VARIABLE if ((e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.flavor != FL_PARAMETER) && e->symtree->n.sym->attr.flavor != FL_PARAMETER)
|| (e->expr_type == EXPR_FUNCTION || (e->expr_type == EXPR_FUNCTION
...@@ -294,7 +285,6 @@ variable_check (gfc_expr * e, int n) ...@@ -294,7 +285,6 @@ variable_check (gfc_expr * e, int n)
static try static try
dim_check (gfc_expr * dim, int n, int optional) dim_check (gfc_expr * dim, int n, int optional)
{ {
if (optional) if (optional)
{ {
if (dim == NULL) if (dim == NULL)
...@@ -363,7 +353,6 @@ dim_rank_check (gfc_expr * dim, gfc_expr * array, int allow_assumed) ...@@ -363,7 +353,6 @@ dim_rank_check (gfc_expr * dim, gfc_expr * array, int allow_assumed)
static try static try
check_a_kind (gfc_expr * a, gfc_expr * kind, bt type) check_a_kind (gfc_expr * a, gfc_expr * kind, bt type)
{ {
if (type_check (a, 0, BT_REAL) == FAILURE) if (type_check (a, 0, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
if (kind_check (kind, 1, type) == FAILURE) if (kind_check (kind, 1, type) == FAILURE)
...@@ -377,7 +366,6 @@ check_a_kind (gfc_expr * a, gfc_expr * kind, bt type) ...@@ -377,7 +366,6 @@ check_a_kind (gfc_expr * a, gfc_expr * kind, bt type)
try try
gfc_check_a_ikind (gfc_expr * a, gfc_expr * kind) gfc_check_a_ikind (gfc_expr * a, gfc_expr * kind)
{ {
return check_a_kind (a, kind, BT_INTEGER); return check_a_kind (a, kind, BT_INTEGER);
} }
...@@ -386,14 +374,12 @@ gfc_check_a_ikind (gfc_expr * a, gfc_expr * kind) ...@@ -386,14 +374,12 @@ gfc_check_a_ikind (gfc_expr * a, gfc_expr * kind)
try try
gfc_check_a_xkind (gfc_expr * a, gfc_expr * kind) gfc_check_a_xkind (gfc_expr * a, gfc_expr * kind)
{ {
return check_a_kind (a, kind, BT_REAL); return check_a_kind (a, kind, BT_REAL);
} }
try try
gfc_check_abs (gfc_expr * a) gfc_check_abs (gfc_expr * a)
{ {
if (numeric_check (a, 0) == FAILURE) if (numeric_check (a, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -404,7 +390,6 @@ gfc_check_abs (gfc_expr * a) ...@@ -404,7 +390,6 @@ gfc_check_abs (gfc_expr * a)
try try
gfc_check_all_any (gfc_expr * mask, gfc_expr * dim) gfc_check_all_any (gfc_expr * mask, gfc_expr * dim)
{ {
if (logical_array_check (mask, 0) == FAILURE) if (logical_array_check (mask, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -418,7 +403,6 @@ gfc_check_all_any (gfc_expr * mask, gfc_expr * dim) ...@@ -418,7 +403,6 @@ gfc_check_all_any (gfc_expr * mask, gfc_expr * dim)
try try
gfc_check_allocated (gfc_expr * array) gfc_check_allocated (gfc_expr * array)
{ {
if (variable_check (array, 0) == FAILURE) if (variable_check (array, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -441,7 +425,6 @@ gfc_check_allocated (gfc_expr * array) ...@@ -441,7 +425,6 @@ gfc_check_allocated (gfc_expr * array)
try try
gfc_check_a_p (gfc_expr * a, gfc_expr * p) gfc_check_a_p (gfc_expr * a, gfc_expr * p)
{ {
if (int_or_real_check (a, 0) == FAILURE) if (int_or_real_check (a, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -520,13 +503,12 @@ gfc_check_atan2 (gfc_expr * y, gfc_expr * x) ...@@ -520,13 +503,12 @@ gfc_check_atan2 (gfc_expr * y, gfc_expr * x)
return SUCCESS; return SUCCESS;
} }
/* BESJN and BESYN functions. */ /* BESJN and BESYN functions. */
try try
gfc_check_besn (gfc_expr * n, gfc_expr * x) gfc_check_besn (gfc_expr * n, gfc_expr * x)
{ {
if (scalar_check (n, 0) == FAILURE) if (scalar_check (n, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -546,7 +528,6 @@ gfc_check_besn (gfc_expr * n, gfc_expr * x) ...@@ -546,7 +528,6 @@ gfc_check_besn (gfc_expr * n, gfc_expr * x)
try try
gfc_check_btest (gfc_expr * i, gfc_expr * pos) gfc_check_btest (gfc_expr * i, gfc_expr * pos)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
if (type_check (pos, 1, BT_INTEGER) == FAILURE) if (type_check (pos, 1, BT_INTEGER) == FAILURE)
...@@ -559,7 +540,6 @@ gfc_check_btest (gfc_expr * i, gfc_expr * pos) ...@@ -559,7 +540,6 @@ gfc_check_btest (gfc_expr * i, gfc_expr * pos)
try try
gfc_check_char (gfc_expr * i, gfc_expr * kind) gfc_check_char (gfc_expr * i, gfc_expr * kind)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
if (kind_check (kind, 1, BT_CHARACTER) == FAILURE) if (kind_check (kind, 1, BT_CHARACTER) == FAILURE)
...@@ -572,7 +552,6 @@ gfc_check_char (gfc_expr * i, gfc_expr * kind) ...@@ -572,7 +552,6 @@ gfc_check_char (gfc_expr * i, gfc_expr * kind)
try try
gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind) gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind)
{ {
if (numeric_check (x, 0) == FAILURE) if (numeric_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -598,7 +577,6 @@ gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind) ...@@ -598,7 +577,6 @@ gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind)
try try
gfc_check_count (gfc_expr * mask, gfc_expr * dim) gfc_check_count (gfc_expr * mask, gfc_expr * dim)
{ {
if (logical_array_check (mask, 0) == FAILURE) if (logical_array_check (mask, 0) == FAILURE)
return FAILURE; return FAILURE;
if (dim_check (dim, 1, 1) == FAILURE) if (dim_check (dim, 1, 1) == FAILURE)
...@@ -611,7 +589,6 @@ gfc_check_count (gfc_expr * mask, gfc_expr * dim) ...@@ -611,7 +589,6 @@ gfc_check_count (gfc_expr * mask, gfc_expr * dim)
try try
gfc_check_cshift (gfc_expr * array, gfc_expr * shift, gfc_expr * dim) gfc_check_cshift (gfc_expr * array, gfc_expr * shift, gfc_expr * dim)
{ {
if (array_check (array, 0) == FAILURE) if (array_check (array, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -635,7 +612,6 @@ gfc_check_cshift (gfc_expr * array, gfc_expr * shift, gfc_expr * dim) ...@@ -635,7 +612,6 @@ gfc_check_cshift (gfc_expr * array, gfc_expr * shift, gfc_expr * dim)
try try
gfc_check_dcmplx (gfc_expr * x, gfc_expr * y) gfc_check_dcmplx (gfc_expr * x, gfc_expr * y)
{ {
if (numeric_check (x, 0) == FAILURE) if (numeric_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -658,7 +634,6 @@ gfc_check_dcmplx (gfc_expr * x, gfc_expr * y) ...@@ -658,7 +634,6 @@ gfc_check_dcmplx (gfc_expr * x, gfc_expr * y)
try try
gfc_check_dble (gfc_expr * x) gfc_check_dble (gfc_expr * x)
{ {
if (numeric_check (x, 0) == FAILURE) if (numeric_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -669,7 +644,6 @@ gfc_check_dble (gfc_expr * x) ...@@ -669,7 +644,6 @@ gfc_check_dble (gfc_expr * x)
try try
gfc_check_digits (gfc_expr * x) gfc_check_digits (gfc_expr * x)
{ {
if (int_or_real_check (x, 0) == FAILURE) if (int_or_real_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -680,7 +654,6 @@ gfc_check_digits (gfc_expr * x) ...@@ -680,7 +654,6 @@ gfc_check_digits (gfc_expr * x)
try try
gfc_check_dot_product (gfc_expr * vector_a, gfc_expr * vector_b) gfc_check_dot_product (gfc_expr * vector_a, gfc_expr * vector_b)
{ {
switch (vector_a->ts.type) switch (vector_a->ts.type)
{ {
case BT_LOGICAL: case BT_LOGICAL:
...@@ -714,7 +687,6 @@ try ...@@ -714,7 +687,6 @@ try
gfc_check_eoshift (gfc_expr * array, gfc_expr * shift, gfc_expr * boundary, gfc_check_eoshift (gfc_expr * array, gfc_expr * shift, gfc_expr * boundary,
gfc_expr * dim) gfc_expr * dim)
{ {
if (array_check (array, 0) == FAILURE) if (array_check (array, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -749,7 +721,6 @@ gfc_check_eoshift (gfc_expr * array, gfc_expr * shift, gfc_expr * boundary, ...@@ -749,7 +721,6 @@ gfc_check_eoshift (gfc_expr * array, gfc_expr * shift, gfc_expr * boundary,
try try
gfc_check_fnum (gfc_expr * unit) gfc_check_fnum (gfc_expr * unit)
{ {
if (type_check (unit, 0, BT_INTEGER) == FAILURE) if (type_check (unit, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -766,7 +737,6 @@ gfc_check_fnum (gfc_expr * unit) ...@@ -766,7 +737,6 @@ gfc_check_fnum (gfc_expr * unit)
try try
gfc_check_g77_math1 (gfc_expr * x) gfc_check_g77_math1 (gfc_expr * x)
{ {
if (scalar_check (x, 0) == FAILURE) if (scalar_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -780,7 +750,6 @@ gfc_check_g77_math1 (gfc_expr * x) ...@@ -780,7 +750,6 @@ gfc_check_g77_math1 (gfc_expr * x)
try try
gfc_check_huge (gfc_expr * x) gfc_check_huge (gfc_expr * x)
{ {
if (int_or_real_check (x, 0) == FAILURE) if (int_or_real_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -793,7 +762,6 @@ gfc_check_huge (gfc_expr * x) ...@@ -793,7 +762,6 @@ gfc_check_huge (gfc_expr * x)
try try
gfc_check_i (gfc_expr * i) gfc_check_i (gfc_expr * i)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -804,7 +772,6 @@ gfc_check_i (gfc_expr * i) ...@@ -804,7 +772,6 @@ gfc_check_i (gfc_expr * i)
try try
gfc_check_iand (gfc_expr * i, gfc_expr * j) gfc_check_iand (gfc_expr * i, gfc_expr * j)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -825,7 +792,6 @@ gfc_check_iand (gfc_expr * i, gfc_expr * j) ...@@ -825,7 +792,6 @@ gfc_check_iand (gfc_expr * i, gfc_expr * j)
try try
gfc_check_ibclr (gfc_expr * i, gfc_expr * pos) gfc_check_ibclr (gfc_expr * i, gfc_expr * pos)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -839,7 +805,6 @@ gfc_check_ibclr (gfc_expr * i, gfc_expr * pos) ...@@ -839,7 +805,6 @@ gfc_check_ibclr (gfc_expr * i, gfc_expr * pos)
try try
gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len) gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -856,7 +821,6 @@ gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len) ...@@ -856,7 +821,6 @@ gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len)
try try
gfc_check_ibset (gfc_expr * i, gfc_expr * pos) gfc_check_ibset (gfc_expr * i, gfc_expr * pos)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -870,7 +834,6 @@ gfc_check_ibset (gfc_expr * i, gfc_expr * pos) ...@@ -870,7 +834,6 @@ gfc_check_ibset (gfc_expr * i, gfc_expr * pos)
try try
gfc_check_idnint (gfc_expr * a) gfc_check_idnint (gfc_expr * a)
{ {
if (double_check (a, 0) == FAILURE) if (double_check (a, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -881,7 +844,6 @@ gfc_check_idnint (gfc_expr * a) ...@@ -881,7 +844,6 @@ gfc_check_idnint (gfc_expr * a)
try try
gfc_check_ieor (gfc_expr * i, gfc_expr * j) gfc_check_ieor (gfc_expr * i, gfc_expr * j)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -902,7 +864,6 @@ gfc_check_ieor (gfc_expr * i, gfc_expr * j) ...@@ -902,7 +864,6 @@ gfc_check_ieor (gfc_expr * i, gfc_expr * j)
try try
gfc_check_index (gfc_expr * string, gfc_expr * substring, gfc_expr * back) gfc_check_index (gfc_expr * string, gfc_expr * substring, gfc_expr * back)
{ {
if (type_check (string, 0, BT_CHARACTER) == FAILURE if (type_check (string, 0, BT_CHARACTER) == FAILURE
|| type_check (substring, 1, BT_CHARACTER) == FAILURE) || type_check (substring, 1, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -924,7 +885,6 @@ gfc_check_index (gfc_expr * string, gfc_expr * substring, gfc_expr * back) ...@@ -924,7 +885,6 @@ gfc_check_index (gfc_expr * string, gfc_expr * substring, gfc_expr * back)
try try
gfc_check_int (gfc_expr * x, gfc_expr * kind) gfc_check_int (gfc_expr * x, gfc_expr * kind)
{ {
if (numeric_check (x, 0) == FAILURE if (numeric_check (x, 0) == FAILURE
|| kind_check (kind, 1, BT_INTEGER) == FAILURE) || kind_check (kind, 1, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -936,7 +896,6 @@ gfc_check_int (gfc_expr * x, gfc_expr * kind) ...@@ -936,7 +896,6 @@ gfc_check_int (gfc_expr * x, gfc_expr * kind)
try try
gfc_check_ior (gfc_expr * i, gfc_expr * j) gfc_check_ior (gfc_expr * i, gfc_expr * j)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE) if (type_check (i, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -957,7 +916,6 @@ gfc_check_ior (gfc_expr * i, gfc_expr * j) ...@@ -957,7 +916,6 @@ gfc_check_ior (gfc_expr * i, gfc_expr * j)
try try
gfc_check_ishft (gfc_expr * i, gfc_expr * shift) gfc_check_ishft (gfc_expr * i, gfc_expr * shift)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE if (type_check (i, 0, BT_INTEGER) == FAILURE
|| type_check (shift, 1, BT_INTEGER) == FAILURE) || type_check (shift, 1, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -969,7 +927,6 @@ gfc_check_ishft (gfc_expr * i, gfc_expr * shift) ...@@ -969,7 +927,6 @@ gfc_check_ishft (gfc_expr * i, gfc_expr * shift)
try try
gfc_check_ishftc (gfc_expr * i, gfc_expr * shift, gfc_expr * size) gfc_check_ishftc (gfc_expr * i, gfc_expr * shift, gfc_expr * size)
{ {
if (type_check (i, 0, BT_INTEGER) == FAILURE if (type_check (i, 0, BT_INTEGER) == FAILURE
|| type_check (shift, 1, BT_INTEGER) == FAILURE) || type_check (shift, 1, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -984,7 +941,6 @@ gfc_check_ishftc (gfc_expr * i, gfc_expr * shift, gfc_expr * size) ...@@ -984,7 +941,6 @@ gfc_check_ishftc (gfc_expr * i, gfc_expr * shift, gfc_expr * size)
try try
gfc_check_kind (gfc_expr * x) gfc_check_kind (gfc_expr * x)
{ {
if (x->ts.type == BT_DERIVED) if (x->ts.type == BT_DERIVED)
{ {
must_be (x, 0, "a non-derived type"); must_be (x, 0, "a non-derived type");
...@@ -998,7 +954,6 @@ gfc_check_kind (gfc_expr * x) ...@@ -998,7 +954,6 @@ gfc_check_kind (gfc_expr * x)
try try
gfc_check_lbound (gfc_expr * array, gfc_expr * dim) gfc_check_lbound (gfc_expr * array, gfc_expr * dim)
{ {
if (array_check (array, 0) == FAILURE) if (array_check (array, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1017,7 +972,6 @@ gfc_check_lbound (gfc_expr * array, gfc_expr * dim) ...@@ -1017,7 +972,6 @@ gfc_check_lbound (gfc_expr * array, gfc_expr * dim)
try try
gfc_check_logical (gfc_expr * a, gfc_expr * kind) gfc_check_logical (gfc_expr * a, gfc_expr * kind)
{ {
if (type_check (a, 0, BT_LOGICAL) == FAILURE) if (type_check (a, 0, BT_LOGICAL) == FAILURE)
return FAILURE; return FAILURE;
if (kind_check (kind, 1, BT_LOGICAL) == FAILURE) if (kind_check (kind, 1, BT_LOGICAL) == FAILURE)
...@@ -1032,7 +986,6 @@ gfc_check_logical (gfc_expr * a, gfc_expr * kind) ...@@ -1032,7 +986,6 @@ gfc_check_logical (gfc_expr * a, gfc_expr * kind)
static try static try
min_max_args (gfc_actual_arglist * arg) min_max_args (gfc_actual_arglist * arg)
{ {
if (arg == NULL || arg->next == NULL) if (arg == NULL || arg->next == NULL)
{ {
gfc_error ("Intrinsic '%s' at %L must have at least two arguments", gfc_error ("Intrinsic '%s' at %L must have at least two arguments",
...@@ -1106,7 +1059,6 @@ gfc_check_min_max (gfc_actual_arglist * arg) ...@@ -1106,7 +1059,6 @@ gfc_check_min_max (gfc_actual_arglist * arg)
try try
gfc_check_min_max_integer (gfc_actual_arglist * arg) gfc_check_min_max_integer (gfc_actual_arglist * arg)
{ {
return check_rest (BT_INTEGER, gfc_default_integer_kind, arg); return check_rest (BT_INTEGER, gfc_default_integer_kind, arg);
} }
...@@ -1114,7 +1066,6 @@ gfc_check_min_max_integer (gfc_actual_arglist * arg) ...@@ -1114,7 +1066,6 @@ gfc_check_min_max_integer (gfc_actual_arglist * arg)
try try
gfc_check_min_max_real (gfc_actual_arglist * arg) gfc_check_min_max_real (gfc_actual_arglist * arg)
{ {
return check_rest (BT_REAL, gfc_default_real_kind, arg); return check_rest (BT_REAL, gfc_default_real_kind, arg);
} }
...@@ -1122,7 +1073,6 @@ gfc_check_min_max_real (gfc_actual_arglist * arg) ...@@ -1122,7 +1073,6 @@ gfc_check_min_max_real (gfc_actual_arglist * arg)
try try
gfc_check_min_max_double (gfc_actual_arglist * arg) gfc_check_min_max_double (gfc_actual_arglist * arg)
{ {
return check_rest (BT_REAL, gfc_default_double_kind, arg); return check_rest (BT_REAL, gfc_default_double_kind, arg);
} }
...@@ -1132,7 +1082,6 @@ gfc_check_min_max_double (gfc_actual_arglist * arg) ...@@ -1132,7 +1082,6 @@ gfc_check_min_max_double (gfc_actual_arglist * arg)
try try
gfc_check_matmul (gfc_expr * matrix_a, gfc_expr * matrix_b) gfc_check_matmul (gfc_expr * matrix_a, gfc_expr * matrix_b)
{ {
if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts)) if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts))
{ {
must_be (matrix_a, 0, "numeric or LOGICAL"); must_be (matrix_a, 0, "numeric or LOGICAL");
...@@ -1265,11 +1214,10 @@ check_reduction (gfc_actual_arglist * ap) ...@@ -1265,11 +1214,10 @@ check_reduction (gfc_actual_arglist * ap)
try try
gfc_check_minval_maxval (gfc_actual_arglist * ap) gfc_check_minval_maxval (gfc_actual_arglist * ap)
{ {
if (int_or_real_check (ap->expr, 0) == FAILURE if (int_or_real_check (ap->expr, 0) == FAILURE
|| array_check (ap->expr, 0) == FAILURE) || array_check (ap->expr, 0) == FAILURE)
return FAILURE; return FAILURE;
return check_reduction (ap); return check_reduction (ap);
} }
...@@ -1277,11 +1225,10 @@ gfc_check_minval_maxval (gfc_actual_arglist * ap) ...@@ -1277,11 +1225,10 @@ gfc_check_minval_maxval (gfc_actual_arglist * ap)
try try
gfc_check_product_sum (gfc_actual_arglist * ap) gfc_check_product_sum (gfc_actual_arglist * ap)
{ {
if (numeric_check (ap->expr, 0) == FAILURE if (numeric_check (ap->expr, 0) == FAILURE
|| array_check (ap->expr, 0) == FAILURE) || array_check (ap->expr, 0) == FAILURE)
return FAILURE; return FAILURE;
return check_reduction (ap); return check_reduction (ap);
} }
...@@ -1289,7 +1236,6 @@ gfc_check_product_sum (gfc_actual_arglist * ap) ...@@ -1289,7 +1236,6 @@ gfc_check_product_sum (gfc_actual_arglist * ap)
try try
gfc_check_merge (gfc_expr * tsource, gfc_expr * fsource, gfc_expr * mask) gfc_check_merge (gfc_expr * tsource, gfc_expr * fsource, gfc_expr * mask)
{ {
if (same_type_check (tsource, 0, fsource, 1) == FAILURE) if (same_type_check (tsource, 0, fsource, 1) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1303,7 +1249,6 @@ gfc_check_merge (gfc_expr * tsource, gfc_expr * fsource, gfc_expr * mask) ...@@ -1303,7 +1249,6 @@ gfc_check_merge (gfc_expr * tsource, gfc_expr * fsource, gfc_expr * mask)
try try
gfc_check_nearest (gfc_expr * x, gfc_expr * s) gfc_check_nearest (gfc_expr * x, gfc_expr * s)
{ {
if (type_check (x, 0, BT_REAL) == FAILURE) if (type_check (x, 0, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1340,7 +1285,6 @@ gfc_check_null (gfc_expr * mold) ...@@ -1340,7 +1285,6 @@ gfc_check_null (gfc_expr * mold)
try try
gfc_check_pack (gfc_expr * array, gfc_expr * mask, gfc_expr * vector) gfc_check_pack (gfc_expr * array, gfc_expr * mask, gfc_expr * vector)
{ {
if (array_check (array, 0) == FAILURE) if (array_check (array, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1371,7 +1315,6 @@ gfc_check_pack (gfc_expr * array, gfc_expr * mask, gfc_expr * vector) ...@@ -1371,7 +1315,6 @@ gfc_check_pack (gfc_expr * array, gfc_expr * mask, gfc_expr * vector)
try try
gfc_check_precision (gfc_expr * x) gfc_check_precision (gfc_expr * x)
{ {
if (x->ts.type != BT_REAL && x->ts.type != BT_COMPLEX) if (x->ts.type != BT_REAL && x->ts.type != BT_COMPLEX)
{ {
must_be (x, 0, "of type REAL or COMPLEX"); must_be (x, 0, "of type REAL or COMPLEX");
...@@ -1410,7 +1353,6 @@ gfc_check_present (gfc_expr * a) ...@@ -1410,7 +1353,6 @@ gfc_check_present (gfc_expr * a)
try try
gfc_check_radix (gfc_expr * x) gfc_check_radix (gfc_expr * x)
{ {
if (int_or_real_check (x, 0) == FAILURE) if (int_or_real_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1421,7 +1363,6 @@ gfc_check_radix (gfc_expr * x) ...@@ -1421,7 +1363,6 @@ gfc_check_radix (gfc_expr * x)
try try
gfc_check_range (gfc_expr * x) gfc_check_range (gfc_expr * x)
{ {
if (numeric_check (x, 0) == FAILURE) if (numeric_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1433,7 +1374,6 @@ gfc_check_range (gfc_expr * x) ...@@ -1433,7 +1374,6 @@ gfc_check_range (gfc_expr * x)
try try
gfc_check_real (gfc_expr * a, gfc_expr * kind) gfc_check_real (gfc_expr * a, gfc_expr * kind)
{ {
if (numeric_check (a, 0) == FAILURE) if (numeric_check (a, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1447,7 +1387,6 @@ gfc_check_real (gfc_expr * a, gfc_expr * kind) ...@@ -1447,7 +1387,6 @@ gfc_check_real (gfc_expr * a, gfc_expr * kind)
try try
gfc_check_repeat (gfc_expr * x, gfc_expr * y) gfc_check_repeat (gfc_expr * x, gfc_expr * y)
{ {
if (type_check (x, 0, BT_CHARACTER) == FAILURE) if (type_check (x, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1516,7 +1455,6 @@ gfc_check_reshape (gfc_expr * source, gfc_expr * shape, ...@@ -1516,7 +1455,6 @@ gfc_check_reshape (gfc_expr * source, gfc_expr * shape,
try try
gfc_check_scale (gfc_expr * x, gfc_expr * i) gfc_check_scale (gfc_expr * x, gfc_expr * i)
{ {
if (type_check (x, 0, BT_REAL) == FAILURE) if (type_check (x, 0, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1530,7 +1468,6 @@ gfc_check_scale (gfc_expr * x, gfc_expr * i) ...@@ -1530,7 +1468,6 @@ gfc_check_scale (gfc_expr * x, gfc_expr * i)
try try
gfc_check_scan (gfc_expr * x, gfc_expr * y, gfc_expr * z) gfc_check_scan (gfc_expr * x, gfc_expr * y, gfc_expr * z)
{ {
if (type_check (x, 0, BT_CHARACTER) == FAILURE) if (type_check (x, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1550,7 +1487,6 @@ gfc_check_scan (gfc_expr * x, gfc_expr * y, gfc_expr * z) ...@@ -1550,7 +1487,6 @@ gfc_check_scan (gfc_expr * x, gfc_expr * y, gfc_expr * z)
try try
gfc_check_selected_real_kind (gfc_expr * p, gfc_expr * r) gfc_check_selected_real_kind (gfc_expr * p, gfc_expr * r)
{ {
if (p == NULL && r == NULL) if (p == NULL && r == NULL)
{ {
gfc_error ("Missing arguments to %s intrinsic at %L", gfc_error ("Missing arguments to %s intrinsic at %L",
...@@ -1572,7 +1508,6 @@ gfc_check_selected_real_kind (gfc_expr * p, gfc_expr * r) ...@@ -1572,7 +1508,6 @@ gfc_check_selected_real_kind (gfc_expr * p, gfc_expr * r)
try try
gfc_check_set_exponent (gfc_expr * x, gfc_expr * i) gfc_check_set_exponent (gfc_expr * x, gfc_expr * i)
{ {
if (type_check (x, 0, BT_REAL) == FAILURE) if (type_check (x, 0, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1605,9 +1540,21 @@ gfc_check_shape (gfc_expr * source) ...@@ -1605,9 +1540,21 @@ gfc_check_shape (gfc_expr * source)
try try
gfc_check_size (gfc_expr * array, gfc_expr * dim) gfc_check_sign (gfc_expr * a, gfc_expr * b)
{ {
if (int_or_real_check (a, 0) == FAILURE)
return FAILURE;
if (same_type_check (a, 0, b, 1) == FAILURE)
return FAILURE;
return SUCCESS;
}
try
gfc_check_size (gfc_expr * array, gfc_expr * dim)
{
if (array_check (array, 0) == FAILURE) if (array_check (array, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1628,23 +1575,8 @@ gfc_check_size (gfc_expr * array, gfc_expr * dim) ...@@ -1628,23 +1575,8 @@ gfc_check_size (gfc_expr * array, gfc_expr * dim)
try try
gfc_check_sign (gfc_expr * a, gfc_expr * b)
{
if (int_or_real_check (a, 0) == FAILURE)
return FAILURE;
if (same_type_check (a, 0, b, 1) == FAILURE)
return FAILURE;
return SUCCESS;
}
try
gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies) gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
{ {
if (source->rank >= GFC_MAX_DIMENSIONS) if (source->rank >= GFC_MAX_DIMENSIONS)
{ {
must_be (source, 0, "less than rank " stringize (GFC_MAX_DIMENSIONS)); must_be (source, 0, "less than rank " stringize (GFC_MAX_DIMENSIONS));
...@@ -1667,7 +1599,6 @@ gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies) ...@@ -1667,7 +1599,6 @@ gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
try try
gfc_check_fstat (gfc_expr * unit, gfc_expr * array) gfc_check_fstat (gfc_expr * unit, gfc_expr * array)
{ {
if (type_check (unit, 0, BT_INTEGER) == FAILURE) if (type_check (unit, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1688,7 +1619,6 @@ gfc_check_fstat (gfc_expr * unit, gfc_expr * array) ...@@ -1688,7 +1619,6 @@ gfc_check_fstat (gfc_expr * unit, gfc_expr * array)
try try
gfc_check_fstat_sub (gfc_expr * unit, gfc_expr * array, gfc_expr * status) gfc_check_fstat_sub (gfc_expr * unit, gfc_expr * array, gfc_expr * status)
{ {
if (type_check (unit, 0, BT_INTEGER) == FAILURE) if (type_check (unit, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1719,7 +1649,6 @@ gfc_check_fstat_sub (gfc_expr * unit, gfc_expr * array, gfc_expr * status) ...@@ -1719,7 +1649,6 @@ gfc_check_fstat_sub (gfc_expr * unit, gfc_expr * array, gfc_expr * status)
try try
gfc_check_stat (gfc_expr * name, gfc_expr * array) gfc_check_stat (gfc_expr * name, gfc_expr * array)
{ {
if (type_check (name, 0, BT_CHARACTER) == FAILURE) if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1737,7 +1666,6 @@ gfc_check_stat (gfc_expr * name, gfc_expr * array) ...@@ -1737,7 +1666,6 @@ gfc_check_stat (gfc_expr * name, gfc_expr * array)
try try
gfc_check_stat_sub (gfc_expr * name, gfc_expr * array, gfc_expr * status) gfc_check_stat_sub (gfc_expr * name, gfc_expr * array, gfc_expr * status)
{ {
if (type_check (name, 0, BT_CHARACTER) == FAILURE) if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1767,7 +1695,6 @@ gfc_check_transfer (gfc_expr * source ATTRIBUTE_UNUSED, ...@@ -1767,7 +1695,6 @@ gfc_check_transfer (gfc_expr * source ATTRIBUTE_UNUSED,
gfc_expr * mold ATTRIBUTE_UNUSED, gfc_expr * mold ATTRIBUTE_UNUSED,
gfc_expr * size) gfc_expr * size)
{ {
if (size != NULL) if (size != NULL)
{ {
if (type_check (size, 2, BT_INTEGER) == FAILURE) if (type_check (size, 2, BT_INTEGER) == FAILURE)
...@@ -1787,7 +1714,6 @@ gfc_check_transfer (gfc_expr * source ATTRIBUTE_UNUSED, ...@@ -1787,7 +1714,6 @@ gfc_check_transfer (gfc_expr * source ATTRIBUTE_UNUSED,
try try
gfc_check_transpose (gfc_expr * matrix) gfc_check_transpose (gfc_expr * matrix)
{ {
if (rank_check (matrix, 0, 2) == FAILURE) if (rank_check (matrix, 0, 2) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1798,7 +1724,6 @@ gfc_check_transpose (gfc_expr * matrix) ...@@ -1798,7 +1724,6 @@ gfc_check_transpose (gfc_expr * matrix)
try try
gfc_check_ubound (gfc_expr * array, gfc_expr * dim) gfc_check_ubound (gfc_expr * array, gfc_expr * dim)
{ {
if (array_check (array, 0) == FAILURE) if (array_check (array, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1810,6 +1735,7 @@ gfc_check_ubound (gfc_expr * array, gfc_expr * dim) ...@@ -1810,6 +1735,7 @@ gfc_check_ubound (gfc_expr * array, gfc_expr * dim)
if (dim_rank_check (dim, array, 0) == FAILURE) if (dim_rank_check (dim, array, 0) == FAILURE)
return FAILURE; return FAILURE;
} }
return SUCCESS; return SUCCESS;
} }
...@@ -1817,7 +1743,6 @@ gfc_check_ubound (gfc_expr * array, gfc_expr * dim) ...@@ -1817,7 +1743,6 @@ gfc_check_ubound (gfc_expr * array, gfc_expr * dim)
try try
gfc_check_unpack (gfc_expr * vector, gfc_expr * mask, gfc_expr * field) gfc_check_unpack (gfc_expr * vector, gfc_expr * mask, gfc_expr * field)
{ {
if (rank_check (vector, 0, 1) == FAILURE) if (rank_check (vector, 0, 1) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1837,7 +1762,6 @@ gfc_check_unpack (gfc_expr * vector, gfc_expr * mask, gfc_expr * field) ...@@ -1837,7 +1762,6 @@ gfc_check_unpack (gfc_expr * vector, gfc_expr * mask, gfc_expr * field)
try try
gfc_check_verify (gfc_expr * x, gfc_expr * y, gfc_expr * z) gfc_check_verify (gfc_expr * x, gfc_expr * y, gfc_expr * z)
{ {
if (type_check (x, 0, BT_CHARACTER) == FAILURE) if (type_check (x, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1870,7 +1794,6 @@ gfc_check_trim (gfc_expr * x) ...@@ -1870,7 +1794,6 @@ gfc_check_trim (gfc_expr * x)
try try
gfc_check_x (gfc_expr * x) gfc_check_x (gfc_expr * x)
{ {
if (type_check (x, 0, BT_REAL) == FAILURE) if (type_check (x, 0, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1883,7 +1806,6 @@ gfc_check_x (gfc_expr * x) ...@@ -1883,7 +1806,6 @@ gfc_check_x (gfc_expr * x)
try try
gfc_check_cpu_time (gfc_expr * time) gfc_check_cpu_time (gfc_expr * time)
{ {
if (scalar_check (time, 0) == FAILURE) if (scalar_check (time, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1901,7 +1823,6 @@ try ...@@ -1901,7 +1823,6 @@ try
gfc_check_date_and_time (gfc_expr * date, gfc_expr * time, gfc_check_date_and_time (gfc_expr * date, gfc_expr * time,
gfc_expr * zone, gfc_expr * values) gfc_expr * zone, gfc_expr * values)
{ {
if (date != NULL) if (date != NULL)
{ {
if (type_check (date, 0, BT_CHARACTER) == FAILURE) if (type_check (date, 0, BT_CHARACTER) == FAILURE)
...@@ -1952,7 +1873,6 @@ try ...@@ -1952,7 +1873,6 @@ try
gfc_check_mvbits (gfc_expr * from, gfc_expr * frompos, gfc_expr * len, gfc_check_mvbits (gfc_expr * from, gfc_expr * frompos, gfc_expr * len,
gfc_expr * to, gfc_expr * topos) gfc_expr * to, gfc_expr * topos)
{ {
if (type_check (from, 0, BT_INTEGER) == FAILURE) if (type_check (from, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1978,7 +1898,6 @@ gfc_check_mvbits (gfc_expr * from, gfc_expr * frompos, gfc_expr * len, ...@@ -1978,7 +1898,6 @@ gfc_check_mvbits (gfc_expr * from, gfc_expr * frompos, gfc_expr * len,
try try
gfc_check_random_number (gfc_expr * harvest) gfc_check_random_number (gfc_expr * harvest)
{ {
if (type_check (harvest, 0, BT_REAL) == FAILURE) if (type_check (harvest, 0, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
...@@ -1992,7 +1911,6 @@ gfc_check_random_number (gfc_expr * harvest) ...@@ -1992,7 +1911,6 @@ gfc_check_random_number (gfc_expr * harvest)
try try
gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get) gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get)
{ {
if (size != NULL) if (size != NULL)
{ {
if (scalar_check (size, 0) == FAILURE) if (scalar_check (size, 0) == FAILURE)
...@@ -2057,7 +1975,6 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get) ...@@ -2057,7 +1975,6 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get)
try try
gfc_check_second_sub (gfc_expr * time) gfc_check_second_sub (gfc_expr * time)
{ {
if (scalar_check (time, 0) == FAILURE) if (scalar_check (time, 0) == FAILURE)
return FAILURE; return FAILURE;
...@@ -2078,7 +1995,6 @@ try ...@@ -2078,7 +1995,6 @@ try
gfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate, gfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate,
gfc_expr * count_max) gfc_expr * count_max)
{ {
if (count != NULL) if (count != NULL)
{ {
if (scalar_check (count, 0) == FAILURE) if (scalar_check (count, 0) == FAILURE)
...@@ -2102,7 +2018,8 @@ gfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate, ...@@ -2102,7 +2018,8 @@ gfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate,
if (variable_check (count_rate, 1) == FAILURE) if (variable_check (count_rate, 1) == FAILURE)
return FAILURE; return FAILURE;
if (count != NULL && same_type_check(count, 0, count_rate, 1) == FAILURE) if (count != NULL
&& same_type_check (count, 0, count_rate, 1) == FAILURE)
return FAILURE; return FAILURE;
} }
...@@ -2118,16 +2035,16 @@ gfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate, ...@@ -2118,16 +2035,16 @@ gfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate,
if (variable_check (count_max, 2) == FAILURE) if (variable_check (count_max, 2) == FAILURE)
return FAILURE; return FAILURE;
if (count != NULL && same_type_check(count, 0, count_max, 2) == FAILURE) if (count != NULL
&& same_type_check (count, 0, count_max, 2) == FAILURE)
return FAILURE; return FAILURE;
if (count_rate != NULL if (count_rate != NULL
&& same_type_check(count_rate, 1, count_max, 2) == FAILURE) && same_type_check (count_rate, 1, count_max, 2) == FAILURE)
return FAILURE; return FAILURE;
}
} return SUCCESS;
return SUCCESS;
} }
try try
...@@ -2236,7 +2153,6 @@ gfc_check_etime_sub (gfc_expr * values, gfc_expr * time) ...@@ -2236,7 +2153,6 @@ gfc_check_etime_sub (gfc_expr * values, gfc_expr * time)
try try
gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status) gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status)
{ {
if (type_check (cwd, 0, BT_CHARACTER) == FAILURE) if (type_check (cwd, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -2256,9 +2172,8 @@ gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status) ...@@ -2256,9 +2172,8 @@ gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status)
try try
gfc_check_exit (gfc_expr * status) gfc_check_exit (gfc_expr * status)
{ {
if (status == NULL) if (status == NULL)
return SUCCESS; return SUCCESS;
if (type_check (status, 0, BT_INTEGER) == FAILURE) if (type_check (status, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -2273,7 +2188,6 @@ gfc_check_exit (gfc_expr * status) ...@@ -2273,7 +2188,6 @@ gfc_check_exit (gfc_expr * status)
try try
gfc_check_flush (gfc_expr * unit) gfc_check_flush (gfc_expr * unit)
{ {
if (unit == NULL) if (unit == NULL)
return SUCCESS; return SUCCESS;
...@@ -2290,7 +2204,6 @@ gfc_check_flush (gfc_expr * unit) ...@@ -2290,7 +2204,6 @@ gfc_check_flush (gfc_expr * unit)
try try
gfc_check_umask (gfc_expr * mask) gfc_check_umask (gfc_expr * mask)
{ {
if (type_check (mask, 0, BT_INTEGER) == FAILURE) if (type_check (mask, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -2304,7 +2217,6 @@ gfc_check_umask (gfc_expr * mask) ...@@ -2304,7 +2217,6 @@ gfc_check_umask (gfc_expr * mask)
try try
gfc_check_umask_sub (gfc_expr * mask, gfc_expr * old) gfc_check_umask_sub (gfc_expr * mask, gfc_expr * old)
{ {
if (type_check (mask, 0, BT_INTEGER) == FAILURE) if (type_check (mask, 0, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -2327,7 +2239,6 @@ gfc_check_umask_sub (gfc_expr * mask, gfc_expr * old) ...@@ -2327,7 +2239,6 @@ gfc_check_umask_sub (gfc_expr * mask, gfc_expr * old)
try try
gfc_check_unlink (gfc_expr * name) gfc_check_unlink (gfc_expr * name)
{ {
if (type_check (name, 0, BT_CHARACTER) == FAILURE) if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -2338,7 +2249,6 @@ gfc_check_unlink (gfc_expr * name) ...@@ -2338,7 +2249,6 @@ gfc_check_unlink (gfc_expr * name)
try try
gfc_check_unlink_sub (gfc_expr * name, gfc_expr * status) gfc_check_unlink_sub (gfc_expr * name, gfc_expr * status)
{ {
if (type_check (name, 0, BT_CHARACTER) == FAILURE) if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE; return FAILURE;
......
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