From 9857bf0dc83841c6d888c517d8bce5c48e59d6bf Mon Sep 17 00:00:00 2001 From: pbrook Date: Sat, 22 May 2004 11:03:17 +0000 Subject: [PATCH] * invoke.texi: Document -Wunderflow and spell check. * lang.opt: Add Wunderflow. * gfortran.h (gfc_option_t): Add warn_underflow option. * options.c (gfc_init_options, set_Wall): Use it. * primary.c (match_real_constant): Explicitly handle UNDERFLOW. * arith.c (gfc_arith_uminus, gfc_arith_plus, gfc_arith_minus, gfc_arith_times, gfc_arith_divide, gfc_arith_power, gfc_real2real, gfc_real2complex, gfc_complex2real, gfc_complex2complex): Ditto. * arith.c (common_logarithm): Fix typo in comment. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@82130 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 12 +++++ gcc/fortran/arith.c | 133 +++++++++++++++++++++++++++++++++++++++++------- gcc/fortran/gfortran.h | 1 + gcc/fortran/invoke.texi | 32 +++++++----- gcc/fortran/lang.opt | 4 ++ gcc/fortran/options.c | 6 +++ gcc/fortran/primary.c | 6 ++- 7 files changed, 162 insertions(+), 32 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fefaac0e0af..7b24d047200 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2004-05-22 Steven G. Kargl + + * invoke.texi: Document -Wunderflow and spell check. + * lang.opt: Add Wunderflow. + * gfortran.h (gfc_option_t): Add warn_underflow option. + * options.c (gfc_init_options, set_Wall): Use it. + * primary.c (match_real_constant): Explicitly handle UNDERFLOW. + * arith.c (gfc_arith_uminus, gfc_arith_plus, gfc_arith_minus, + gfc_arith_times, gfc_arith_divide, gfc_arith_power, gfc_real2real, + gfc_real2complex, gfc_complex2real, gfc_complex2complex): Ditto. + * arith.c (common_logarithm): Fix typo in comment. + 2004-05-21 Roger Sayle * io.c (check_format): As a GNU extension, allow the comma after a diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 4c036aef586..6b7b29a18ad 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -153,7 +153,7 @@ natural_logarithm (mpf_t * arg, mpf_t * result) /* Calculate the common logarithm of arg. We use the natural - logaritm of arg and of 10: + logarithm of arg and of 10: log10(arg) = log(arg)/log(10) */ @@ -1173,7 +1173,9 @@ gfc_arith_neqv (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) /* Make sure a constant numeric expression is within the range for - its type and kind. Note that there's also a gfc_check_range(), + its type and kind. GMP is doing 130 bit arithmetic, so an UNDERFLOW + is numerically zero for REAL(4) and REAL(8) types. Reset the value(s) + to exactly 0 for UNDERFLOW. Note that there's also a gfc_check_range(), but that one deals with the intrinsic RANGE function. */ arith @@ -1189,12 +1191,20 @@ gfc_range_check (gfc_expr * e) case BT_REAL: rc = gfc_check_real_range (e->value.real, e->ts.kind); + if (rc == ARITH_UNDERFLOW) + mpf_set_ui (e->value.real, 0); break; case BT_COMPLEX: rc = gfc_check_real_range (e->value.complex.r, e->ts.kind); - if (rc == ARITH_OK) - rc = gfc_check_real_range (e->value.complex.i, e->ts.kind); + if (rc == ARITH_UNDERFLOW) + mpf_set_ui (e->value.real, 0); + if (rc == ARITH_OK || rc == ARITH_UNDERFLOW) + { + rc = gfc_check_real_range (e->value.complex.i, e->ts.kind); + if (rc == ARITH_UNDERFLOW) + mpf_set_ui (e->value.real, 0); + } break; @@ -1248,7 +1258,14 @@ gfc_arith_uminus (gfc_expr * op1, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc != ARITH_OK) + 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_OK) gfc_free_expr (result); else *resultp = result; @@ -1289,7 +1306,14 @@ gfc_arith_plus (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc != ARITH_OK) + 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_OK) gfc_free_expr (result); else *resultp = result; @@ -1331,7 +1355,14 @@ gfc_arith_minus (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc != ARITH_OK) + 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_OK) gfc_free_expr (result); else *resultp = result; @@ -1382,7 +1413,14 @@ gfc_arith_times (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) rc = gfc_range_check (result); - if (rc != ARITH_OK) + 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_OK) gfc_free_expr (result); else *resultp = result; @@ -1464,7 +1502,14 @@ gfc_arith_divide (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) if (rc == ARITH_OK) rc = gfc_range_check (result); - if (rc != ARITH_OK) + 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_OK) gfc_free_expr (result); else *resultp = result; @@ -1642,7 +1687,14 @@ gfc_arith_power (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) if (rc == ARITH_OK) rc = gfc_range_check (result); - if (rc != ARITH_OK) + 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_OK) gfc_free_expr (result); else *resultp = result; @@ -2531,8 +2583,8 @@ 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); - /* TODO: Do something about the error, ie underflow rounds to 0, - throw exception, return NaN, etc. */ + /* TODO: Do something about the error, ie, throw exception, return + NaN, etc. */ } /* Convert integers to integers. */ @@ -2642,7 +2694,15 @@ gfc_real2real (gfc_expr * src, int kind) mpf_set (result->value.real, src->value.real); - if ((rc = gfc_check_real_range (result->value.real, kind)) != ARITH_OK) + rc = gfc_check_real_range (result->value.real, kind); + + if (rc == ARITH_UNDERFLOW) + { + if (gfc_option.warn_underflow) + gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + mpf_set_ui(result->value.real, 0); + } + else if (rc != ARITH_OK) { arith_error (rc, &src->ts, &result->ts, &src->where); gfc_free_expr (result); @@ -2666,7 +2726,15 @@ gfc_real2complex (gfc_expr * src, int kind) mpf_set (result->value.complex.r, src->value.real); mpf_set_ui (result->value.complex.i, 0); - if ((rc = gfc_check_real_range (result->value.complex.r, kind)) != ARITH_OK) + rc = gfc_check_real_range (result->value.complex.r, kind); + + if (rc == ARITH_UNDERFLOW) + { + if (gfc_option.warn_underflow) + gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + mpf_set_ui(result->value.complex.r, 0); + } + else if (rc != ARITH_OK) { arith_error (rc, &src->ts, &result->ts, &src->where); gfc_free_expr (result); @@ -2713,7 +2781,15 @@ gfc_complex2real (gfc_expr * src, int kind) mpf_set (result->value.real, src->value.complex.r); - if ((rc = gfc_check_real_range (result->value.real, kind)) != ARITH_OK) + rc = gfc_check_real_range (result->value.real, kind); + + if (rc == ARITH_UNDERFLOW) + { + if (gfc_option.warn_underflow) + gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + mpf_set_ui(result->value.real, 0); + } + if (rc != ARITH_OK) { arith_error (rc, &src->ts, &result->ts, &src->where); gfc_free_expr (result); @@ -2737,9 +2813,30 @@ gfc_complex2complex (gfc_expr * src, int kind) mpf_set (result->value.complex.r, src->value.complex.r); mpf_set (result->value.complex.i, src->value.complex.i); - if ((rc = gfc_check_real_range (result->value.complex.r, kind)) != ARITH_OK - || (rc = - gfc_check_real_range (result->value.complex.i, kind)) != ARITH_OK) + rc = gfc_check_real_range (result->value.complex.r, kind); + + if (rc == ARITH_UNDERFLOW) + { + if (gfc_option.warn_underflow) + gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + mpf_set_ui(result->value.complex.r, 0); + } + else if (rc != ARITH_OK) + { + arith_error (rc, &src->ts, &result->ts, &src->where); + gfc_free_expr (result); + return NULL; + } + + rc = gfc_check_real_range (result->value.complex.i, kind); + + if (rc == ARITH_UNDERFLOW) + { + if (gfc_option.warn_underflow) + gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); + mpf_set_ui(result->value.complex.i, 0); + } + else if (rc != ARITH_OK) { arith_error (rc, &src->ts, &result->ts, &src->where); gfc_free_expr (result); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index e698cd3c800..35c2e0852bb 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1215,6 +1215,7 @@ typedef struct int warn_conversion; int warn_implicit_interface; int warn_line_truncation; + int warn_underflow; int warn_surprising; int warn_unused_labels; diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 88330e1bda0..138951b221e 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -126,7 +126,7 @@ by type. Explanations are in the following sections. @gccoptlist{ -fsyntax-only -pedantic -pedantic-errors @gol -w -Wall -Waliasing -Wconversion @gol --Wimplicit-interface -Wsurprising -Wunused-labels @gol +-Wimplicit-interface -Wsurprising -Wunderflow -Wunused-labels @gol -Wline-truncation @gol -Werror -W} @@ -222,7 +222,7 @@ to them to fill out the line. Specify the maximum allowed identifier length. Typical values are 31 (Fortran 95) and 63 (Fortran 200x). -@cindex -fimpicit-none option +@cindex -fimplicit-none option @cindex options, -fimplicit-none @item -fimplicit-none Specify that no implicit typing is allowed, unless overridden by explicit @@ -318,7 +318,7 @@ Inhibit all warning messages. @cindex warnings, all Enables commonly used warning options that which pertain to usage that we recommend avoiding and that we believe is easy to avoid. -This currenly includes @option{-Wunused-labels}, @option{-Waliasing}, +This currently includes @option{-Wunused-labels}, @option{-Waliasing}, @option{-Wsurprising} and @option{-Wline-truncation}. @@ -327,7 +327,7 @@ This currenly includes @option{-Wunused-labels}, @option{-Waliasing}, @item -Waliasing @cindex aliasing Warn about possible aliasing of dummy arguments. The following example -witll trigger teh warhing as it would be illegal to @code{bar} to +will trigger the warning as it would be illegal to @code{bar} to modify either parameter. @smallexample INTEGER A @@ -354,8 +354,8 @@ check that the declared interfaces are consistent across program units. @cindex options, -Wsurprising @item -Wsurprising @cindex Suspicious -Produce a warning when ``suspicous'' code constructs are encountered. -While techically legal these usually indicate that an error has been made. +Produce a warning when ``suspicious'' code constructs are encountered. +While technically legal these usually indicate that an error has been made. This currently produces a warning under the following circumstances: @@ -368,6 +368,14 @@ lower value that is greater than its upper value. A LOGICAL SELECT construct has three CASE statements. @end itemize +@cindex -Wunderflow +@cindex options, -Wunderflow +@item -Wunderflow +@cindex UNDERFLOW +Produce a warning when numerical constant expressions are +encountered, which yield an UNDERFLOW during compilation. + + @cindex -Wunused-labels option @cindex options, -Wunused-labels @item -Wunused-labels @@ -412,7 +420,7 @@ either your program or @command{gfortran} @cindex option, -fdump-parse-tree @item -fdump-parse-tree Output the internal parse tree before starting code generation. Only -really usedful for debugging gfortran itself. +really useful for debugging gfortran itself. @end table @xref{Debugging Options,,Options for Debugging Your Program or GCC, @@ -432,7 +440,7 @@ for files specified via the @code{INCLUDE} directive, and where it searches for previously compiled modules. It also affects the search paths used by @command{cpp} when used to preprocess -fortran source. +Fortran source. @table @gcctabopt @cindex -Idir option @@ -463,8 +471,8 @@ gcc,Using the GNU Compiler Collection (GCC)}, for information on the @cindex option, -Mdir @item -M@var{dir} @item -J@var{dir} -This option specifies where to put @samp{.mod} files for compiled modiles. -It is also added to the list of directories to searhed by an @code{USE} +This option specifies where to put @samp{.mod} files for compiled modules. +It is also added to the list of directories to searched by an @code{USE} statement. The default is the current directory. @@ -596,7 +604,7 @@ and against the declared minimum and maximum values. It also checks array indices for assumed and deferred shape arrays against the actual allocated bounds. -In the future this may also include other forms of checking, eg. checing +In the future this may also include other forms of checking, eg. checking substring references. @@ -615,7 +623,7 @@ The default value for @var{n} is 32768. @item -fpackderived @cindex Structure packing This option tells gfortran to pack derived type members as closely as -possible. Code compiled with this option is likley to be incompatible +possible. Code compiled with this option is likely to be incompatible with code compiled without this option, and may execute slower. @cindex -frepack-arrays option diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 08065c474b9..ff670d66f2b 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -57,6 +57,10 @@ Wsurprising F95 Warn about \"suspicious\" constructs +Wunderflow +F95 +Warn about underflow of numerical constant expressions + Wunused-labels F95 Warn when a label is unused diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index f0135bd7f95..b0f9a76e5f2 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -56,6 +56,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_option.warn_conversion = 0; gfc_option.warn_implicit_interface = 0; gfc_option.warn_line_truncation = 0; + gfc_option.warn_underflow = 1; gfc_option.warn_surprising = 0; gfc_option.warn_unused_labels = 0; @@ -123,6 +124,7 @@ set_Wall (void) gfc_option.warn_aliasing = 1; gfc_option.warn_line_truncation = 1; + gfc_option.warn_underflow = 1; gfc_option.warn_surprising = 1; gfc_option.warn_unused_labels = 1; @@ -198,6 +200,10 @@ gfc_handle_option (size_t scode, const char *arg, int value) gfc_option.warn_line_truncation = value; break; + case OPT_Wunderflow: + gfc_option.warn_underflow = value; + break; + case OPT_Wsurprising: gfc_option.warn_surprising = value; break; diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 0e7e7e796aa..a55c5aa6781 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -489,8 +489,10 @@ done: goto cleanup; case ARITH_UNDERFLOW: - gfc_error ("Real constant underflows its kind at %C"); - goto cleanup; + if (gfc_option.warn_underflow) + gfc_warning ("Real constant underflows its kind at %C"); + mpf_set_ui(e->value.real, 0); + break; default: gfc_internal_error ("gfc_range_check() returned bad value"); -- 2.11.0