* 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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fefaac0..7b24d04 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2004-05-22  Steven G. Kargl  <kargls@comcast.net>
+
+       * 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  <roger@eyesopen.com>
 
        * io.c (check_format): As a GNU extension, allow the comma after a
 2004-05-21  Roger Sayle  <roger@eyesopen.com>
 
        * 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 4c036ae..6b7b29a 100644 (file)
--- 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
 
 
 /* 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)  */
 
 
    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
 
 
 /* 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
    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);
 
     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);
       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;
 
 
       break;
 


@@ -1248,7 +1258,14 @@ gfc_arith_uminus (gfc_expr * op1, gfc_expr ** resultp)
 
   rc = gfc_range_check (result);
 
 
   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;
     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);
 
 
   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;
     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);
 
 
   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;
     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);
 
 
   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;
     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)
     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;
     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)
     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;
     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);
 
   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.  */
 }
 
 /* Convert integers to integers.  */


@@ -2642,7 +2694,15 @@ gfc_real2real (gfc_expr * src, int kind)
 
   mpf_set (result->value.real, src->value.real);
 
 
   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);
     {
       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);
 
   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);
     {
       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);
 
 
   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);
     {
       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);
 
   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);
     {
       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 e698cd3..35c2e08 100644 (file)
--- 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_conversion;
   int warn_implicit_interface;
   int warn_line_truncation;

+  int warn_underflow;

   int warn_surprising;
   int warn_unused_labels;
 
   int warn_surprising;
   int warn_unused_labels;
 

diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 88330e1..138951b 100644 (file)
--- 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
 @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}
 
 -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).
 
 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
 @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.
 @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}.
 
 
 @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
 @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
 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
 @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:
 
 
 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
 
 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
 @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
 @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,
 @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
 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
 
 @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}
 @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.
 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.
 
 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.
 
 
 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
 @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
 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 08065c4..ff670d6 100644 (file)
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -57,6 +57,10 @@ Wsurprising
 F95
 Warn about \"suspicious\" constructs
 
 F95
 Warn about \"suspicious\" constructs
 

+Wunderflow
+F95
+Warn about underflow of numerical constant expressions
+

 Wunused-labels
 F95
 Warn when a label is unused
 Wunused-labels
 F95
 Warn when a label is unused

diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index f0135bd..b0f9a76 100644 (file)
--- 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_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;
 
   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_aliasing = 1;
   gfc_option.warn_line_truncation = 1;

+  gfc_option.warn_underflow = 1;

   gfc_option.warn_surprising = 1;
   gfc_option.warn_unused_labels = 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;
 
       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;
     case OPT_Wsurprising:
       gfc_option.warn_surprising = value;
       break;

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 0e7e7e7..a55c5aa 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -489,8 +489,10 @@ done:
       goto cleanup;
 
     case ARITH_UNDERFLOW:
       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");
 
     default:
       gfc_internal_error ("gfc_range_check() returned bad value");