From 5a95dfde57dfc0e31ddb05665f39d3ff294e9fce Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sun, 27 Feb 2005 17:32:26 +0000 Subject: [PATCH] arith.c (gfc_check_real_range): Remove multiple returns * arith.c (gfc_check_real_range): Remove multiple returns (check_result): New function. (gfc_arith_uminus,gfc_arith_plus,gfc_arith_times, gfc_arith_divide,gfc_arith_power,gfc_arith_minus): Use it. From-SVN: r95624 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/arith.c | 159 ++++++++++-------------------------------- 2 files changed, 43 insertions(+), 124 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 846186a3174..f5c23a3903f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2005-02-27 Steven G. Kargl + + * arith.c (gfc_check_real_range): Remove multiple returns + (check_result): New function. + (gfc_arith_uminus,gfc_arith_plus,gfc_arith_times, + gfc_arith_divide,gfc_arith_power,gfc_arith_minus): Use it. + + 2005-02-24 Volker Reichelt * decl.c, resolve.c, trans-array.c, trans.h: Fix comment typo(s). diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index a219ed20675..9bcfa0a007d 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -373,20 +373,15 @@ gfc_check_real_range (mpfr_t p, int kind) mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); - retval = ARITH_OK; if (mpfr_sgn (q) == 0) - goto done; - - if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) - { + retval = ARITH_OK; + else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) retval = ARITH_OVERFLOW; - goto done; - } - - if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0) + else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0) retval = ARITH_UNDERFLOW; + else + retval = ARITH_OK; -done: mpfr_clear (q); return retval; @@ -554,6 +549,30 @@ gfc_range_check (gfc_expr * e) } +/* Several of the following routines use the same set of statements to + check the validity of the result. Encapsulate the checking here. */ + +static arith +check_result (arith rc, gfc_expr * x, gfc_expr * r, gfc_expr ** rp) +{ + if (rc != ARITH_OK) + gfc_free_expr (r); + else + { + if (rc == ARITH_UNDERFLOW && gfc_option.warn_underflow) + gfc_warning ("%s at %L", gfc_arith_error (rc), &x->where); + + if (rc == ARITH_ASYMMETRIC) + gfc_warning ("%s at %L", gfc_arith_error (rc), &x->where); + + rc = ARITH_OK; + *rp = r; + } + + return rc; +} + + /* It may seem silly to have a subroutine that actually computes the unary plus of a constant, but it prevents us from making exceptions in the code elsewhere. */ @@ -595,25 +614,7 @@ gfc_arith_uminus (gfc_expr * op1, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc == ARITH_UNDERFLOW) - { - if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc == ARITH_ASYMMETRIC) - { - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc != ARITH_OK) - gfc_free_expr (result); - else - *resultp = result; - - return rc; + return check_result (rc, op1, result, resultp); } @@ -650,25 +651,7 @@ gfc_arith_plus (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc == ARITH_UNDERFLOW) - { - if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc == ARITH_ASYMMETRIC) - { - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc != ARITH_OK) - gfc_free_expr (result); - else - *resultp = result; - - return rc; + return check_result (rc, op1, result, resultp); } @@ -705,25 +688,7 @@ gfc_arith_minus (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc == ARITH_UNDERFLOW) - { - if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc == ARITH_ASYMMETRIC) - { - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc != ARITH_OK) - gfc_free_expr (result); - else - *resultp = result; - - return rc; + return check_result (rc, op1, result, resultp); } @@ -774,25 +739,7 @@ gfc_arith_times (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc == ARITH_UNDERFLOW) - { - if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc == ARITH_ASYMMETRIC) - { - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc != ARITH_OK) - gfc_free_expr (result); - else - *resultp = result; - - return rc; + return check_result (rc, op1, result, resultp); } @@ -876,25 +823,7 @@ gfc_arith_divide (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) if (rc == ARITH_OK) rc = gfc_range_check (result); - if (rc == ARITH_UNDERFLOW) - { - if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc == ARITH_ASYMMETRIC) - { - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc != ARITH_OK) - gfc_free_expr (result); - else - *resultp = result; - - return rc; + return check_result (rc, op1, result, resultp); } @@ -1072,25 +1001,7 @@ gfc_arith_power (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) if (rc == ARITH_OK) rc = gfc_range_check (result); - if (rc == ARITH_UNDERFLOW) - { - if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc == ARITH_ASYMMETRIC) - { - gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); - rc = ARITH_OK; - *resultp = result; - } - else if (rc != ARITH_OK) - gfc_free_expr (result); - else - *resultp = result; - - return rc; + return check_result (rc, op1, result, resultp); }