Possible fix to PR 14059

[Steve Kargl]

Gang,

Below is a patch that may be a fix for 14059.  Should
gfortran issue a warning for the UNDERFLOW?

-- 
Steve

Index: arith.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.c,v
retrieving revision 1.5
diff -u -b -r1.5 arith.c
--- arith.c	16 May 2004 18:01:38 -0000	1.5
+++ arith.c	16 May 2004 20:32:26 -0000
@@ -1189,12 +1189,22 @@
 
     case BT_REAL:
       rc = gfc_check_real_range (e->value.real, e->ts.kind);
+      /* GMP is doing 130 bit arithmetic, so an UNDERFLOW is numerically zero
+         for 32 bit and 64 bit arithmetic.  */
+      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)
+      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,12 @@
 
   rc = gfc_range_check (result);
 
-  if (rc != ARITH_OK)
+  if (rc == ARITH_UNDERFLOW)
+    {
+      rc = ARITH_OK;
+      *resultp = result;
+    }
+  else if (rc != ARITH_OK)
     gfc_free_expr (result);
   else
     *resultp = result;
@@ -1289,7 +1304,12 @@
 
   rc = gfc_range_check (result);
 
-  if (rc != ARITH_OK)
+  if (rc == ARITH_UNDERFLOW)
+    {
+      rc = ARITH_OK;
+      *resultp = result;
+    }
+  else if (rc != ARITH_OK)
     gfc_free_expr (result);
   else
     *resultp = result;
@@ -1331,7 +1351,12 @@
 
   rc = gfc_range_check (result);
 
-  if (rc != ARITH_OK)
+  if (rc == ARITH_UNDERFLOW)
+    {
+      rc = ARITH_OK;
+      *resultp = result;
+    }
+  else if (rc != ARITH_OK)
     gfc_free_expr (result);
   else
     *resultp = result;
@@ -1382,7 +1407,12 @@
 
   rc = gfc_range_check (result);
 
-  if (rc != ARITH_OK)
+  if (rc == ARITH_UNDERFLOW)
+    {
+      rc = ARITH_OK;
+      *resultp = result;
+    }
+  else if (rc != ARITH_OK)
     gfc_free_expr (result);
   else
     *resultp = result;
@@ -1464,7 +1494,12 @@
   if (rc == ARITH_OK)
     rc = gfc_range_check (result);
 
-  if (rc != ARITH_OK)
+  if (rc == ARITH_UNDERFLOW)
+    {
+      rc = ARITH_OK;
+      *resultp = result;
+    }
+  else if (rc != ARITH_OK)
     gfc_free_expr (result);
   else
     *resultp = result;
@@ -1642,7 +1677,12 @@
   if (rc == ARITH_OK)
     rc = gfc_range_check (result);
 
-  if (rc != ARITH_OK)
+  if (rc == ARITH_UNDERFLOW)
+    {
+      rc = ARITH_OK;
+      *resultp = result;
+    }
+  else if (rc != ARITH_OK)
     gfc_free_expr (result);
   else
     *resultp = result;