FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

arith.c (gfc_check_real_range): Remove multiple returns

Browse source 
* 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
This commit is contained in:
Steven G. Kargl 2005-02-27 17:32:26 +00:00 • committed by Steven G. Kargl
parent 5591e5f9af
commit 5a95dfde57
2 changed files with 43 additions and 124 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2005-02-27 Steven G. Kargl <kargls@comcast.net>
* 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 <reichelt@igpm.rwth-aachen.de>
* decl.c, resolve.c, trans-array.c, trans.h: Fix comment typo(s).

159
gcc/fortran/arith.c
View file

@ -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);
}