diff options
author | Steven G. Kargl <kargls@comcast.net> | 2005-02-27 17:32:26 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2005-02-27 17:32:26 +0000 |
commit | 5a95dfde57dfc0e31ddb05665f39d3ff294e9fce (patch) | |
tree | 6c09d914d9cba7f26679428c447183fd7d3355d4 /gcc/fortran/arith.c | |
parent | 5591e5f9af6f09455a1f11d8e822785e34647186 (diff) | |
download | gcc-5a95dfde57dfc0e31ddb05665f39d3ff294e9fce.zip gcc-5a95dfde57dfc0e31ddb05665f39d3ff294e9fce.tar.gz gcc-5a95dfde57dfc0e31ddb05665f39d3ff294e9fce.tar.bz2 |
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
Diffstat (limited to 'gcc/fortran/arith.c')
-rw-r--r-- | gcc/fortran/arith.c | 159 |
1 files changed, 35 insertions, 124 deletions
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index a219ed2..9bcfa0a 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); } |