diff options
Diffstat (limited to 'gcc/fortran/arith.c')
-rw-r--r-- | gcc/fortran/arith.c | 69 |
1 files changed, 51 insertions, 18 deletions
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index ccc7ae1..e0c1f4b 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -138,25 +138,26 @@ gfc_arith_error (arith code) switch (code) { case ARITH_OK: - p = _("Arithmetic OK"); + p = _("Arithmetic OK at %L"); break; case ARITH_OVERFLOW: - p = _("Arithmetic overflow"); + p = _("Arithmetic overflow at %L"); break; case ARITH_UNDERFLOW: - p = _("Arithmetic underflow"); + p = _("Arithmetic underflow at %L"); break; case ARITH_NAN: - p = _("Arithmetic NaN"); + p = _("Arithmetic NaN at %L"); break; case ARITH_DIV0: - p = _("Division by zero"); + p = _("Division by zero at %L"); break; case ARITH_INCOMMENSURATE: - p = _("Array operands are incommensurate"); + p = _("Array operands are incommensurate at %L"); break; case ARITH_ASYMMETRIC: - p = _("Integer outside symmetric range implied by Standard Fortran"); + p = + _("Integer outside symmetric range implied by Standard Fortran at %L"); break; default: gfc_internal_error ("gfc_arith_error(): Bad error code"); @@ -598,13 +599,13 @@ check_result (arith rc, gfc_expr * x, gfc_expr * r, gfc_expr ** rp) if (val == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (val), &x->where); + gfc_warning (gfc_arith_error (val), &x->where); val = ARITH_OK; } if (val == ARITH_ASYMMETRIC) { - gfc_warning ("%s at %L", gfc_arith_error (val), &x->where); + gfc_warning (gfc_arith_error (val), &x->where); val = ARITH_OK; } @@ -1604,7 +1605,7 @@ eval_intrinsic (gfc_intrinsic_op operator, if (rc != ARITH_OK) { /* Something went wrong */ - gfc_error ("%s at %L", gfc_arith_error (rc), &op1->where); + gfc_error (gfc_arith_error (rc), &op1->where); return NULL; } @@ -1907,8 +1908,40 @@ gfc_convert_complex (gfc_expr * real, gfc_expr * imag, int kind) static void arith_error (arith rc, gfc_typespec * from, gfc_typespec * to, locus * where) { - gfc_error ("%s converting %s to %s at %L", gfc_arith_error (rc), - gfc_typename (from), gfc_typename (to), where); + switch (rc) + { + case ARITH_OK: + gfc_error ("Arithmetic OK converting %s to %s at %L", + gfc_typename (from), gfc_typename (to), where); + break; + case ARITH_OVERFLOW: + gfc_error ("Arithmetic overflow converting %s to %s at %L", + gfc_typename (from), gfc_typename (to), where); + break; + case ARITH_UNDERFLOW: + gfc_error ("Arithmetic underflow converting %s to %s at %L", + gfc_typename (from), gfc_typename (to), where); + break; + case ARITH_NAN: + gfc_error ("Arithmetic NaN converting %s to %s at %L", + gfc_typename (from), gfc_typename (to), where); + break; + case ARITH_DIV0: + gfc_error ("Division by zero converting %s to %s at %L", + gfc_typename (from), gfc_typename (to), where); + break; + case ARITH_INCOMMENSURATE: + gfc_error ("Array operands are incommensurate converting %s to %s at %L", + gfc_typename (from), gfc_typename (to), where); + break; + case ARITH_ASYMMETRIC: + gfc_error ("Integer outside symmetric range implied by Standard Fortran" + " converting %s to %s at %L", + gfc_typename (from), gfc_typename (to), where); + break; + default: + gfc_internal_error ("gfc_arith_error(): Bad error code"); + } /* TODO: Do something about the error, ie, throw exception, return NaN, etc. */ @@ -1931,7 +1964,7 @@ gfc_int2int (gfc_expr * src, int kind) { if (rc == ARITH_ASYMMETRIC) { - gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + gfc_warning (gfc_arith_error (rc), &src->where); } else { @@ -2033,7 +2066,7 @@ gfc_real2real (gfc_expr * src, int kind) if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) @@ -2065,7 +2098,7 @@ gfc_real2complex (gfc_expr * src, int kind) if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) @@ -2120,7 +2153,7 @@ gfc_complex2real (gfc_expr * src, int kind) if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } if (rc != ARITH_OK) @@ -2152,7 +2185,7 @@ gfc_complex2complex (gfc_expr * src, int kind) if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) @@ -2167,7 +2200,7 @@ gfc_complex2complex (gfc_expr * src, int kind) if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) - gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) |