* 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: https://gcc.gnu.org/svn/gcc/trunk@82130 138bc75d-0d04-0410-961f-82ee72b054a4

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  <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
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");