[patch, gfortran] PRs 13490 and 17912, integer ranges

[Scott Robert Ladd <coyote at coyotegulch dot com>]

When this topic came up last year, I was in favor of gfortran working 
like other Fortran 95 compilers, which accept minimum integer values of 
-(2**(n-1)). Several Fortran language lawyers insisted that the default 
behavior should be to reject such values, as they are not symmetrical 
across ABS() (a requirement implied by the Standard.)

My previous patches for this problem have catered to the language 
lawyers by adding a switch to enable "asymmetric" integers. I never 
liked doing it that way.

After a discussion with Tobias Schlüter, I've decided to present the 
following patch, which causes gfortran to behave exactly like other 
Fortran 95 compilers. For a -pedantic compile, gfortran will now display 
a warning about a potential Standard violation.

This patch gives me warm fuzzies. The gods only know what the language 
lawyers will think... :)

Bootstrapped and tested on i686-pc-linux and x86_64-pc-linux.

..Scott

2004-10-21  Scott Robert Ladd  <scott.ladd@coyotegulch.com>

    PRs 13490 17912
    * gcc/fortran/gfortran.h: Added pedantic_min_int to gfc_integer_info

    * gcc/fortran/gfortran.h: Added ARITH_ASYMMETRIC to arith

    * gcc/fortran/arith.c: Added support for an "asymmetric integer"
      warning when compiling with pedantic.

    * gcc/fortran/arith.c: Set minimum integer values to reflect
      realities of two's complement signed integers. Added
      pedantic minimum.

--
Scott Robert Ladd
site: http://www.coyotegulch.com
blog: http://chaoticcoyote.blogspot.com

Index: arith.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.c,v
retrieving revision 1.16
diff -u -3 -p -r1.16 arith.c
--- arith.c	8 Oct 2004 18:53:13 -0000	1.16
+++ arith.c	21 Oct 2004 23:34:04 -0000
@@ -27,6 +27,7 @@ Software Foundation, 59 Temple Place - S
 
 #include "config.h"
 #include "system.h"
+#include "flags.h"
 #include "gfortran.h"
 #include "arith.h"
 
@@ -157,6 +158,9 @@ gfc_arith_error (arith code)
     case ARITH_INCOMMENSURATE:
       p = "Array operands are incommensurate";
       break;
+    case ARITH_ASYMMETRIC:
+      p = "Integer outside symmetric range implied by Standard Fortran";
+      break;
     default:
       gfc_internal_error ("gfc_arith_error(): Bad error code");
     }
@@ -194,11 +198,20 @@ gfc_arith_init_1 (void)
       /* These are the numbers that are actually representable by the
          target.  For bases other than two, this needs to be changed.  */
       if (int_info->radix != 2)
-	gfc_internal_error ("Fix min_int, max_int calculation");
+        gfc_internal_error ("Fix min_int, max_int calculation");
+
+      /* See PRs 13490 and 17912, related to integer ranges.
+         The pedantic_min_int exists for range checking when a program
+         is compiled with -pedantic, and reflects the belief that
+         Standard Fortran requires integers to be symmetrical, i.e.
+         every negative integer must have a representable positive
+         absolute value, and vice versa. */
+         
+      mpz_init (int_info->pedantic_min_int);
+      mpz_neg (int_info->pedantic_min_int, int_info->huge);
 
       mpz_init (int_info->min_int);
-      mpz_neg (int_info->min_int, int_info->huge);
-      /* No -1 here, because the representation is symmetric.  */
+      mpz_sub_ui(int_info->min_int, int_info->pedantic_min_int, 1);
 
       mpz_init (int_info->max_int);
       mpz_add (int_info->max_int, int_info->huge, int_info->huge);
@@ -317,7 +330,8 @@ gfc_arith_done_1 (void)
 
 
 /* Given an integer and a kind, make sure that the integer lies within
-   the range of the kind.  Returns ARITH_OK or ARITH_OVERFLOW.  */
+   the range of the kind.  Returns ARITH_OK, ARITH_ASYMMETRIC or 
+   ARITH_OVERFLOW.  */
 
 static arith
 gfc_check_integer_range (mpz_t p, int kind)
@@ -328,6 +342,12 @@ gfc_check_integer_range (mpz_t p, int ki
   i = gfc_validate_kind (BT_INTEGER, kind, false);
   result = ARITH_OK;
 
+  if (pedantic)
+    {
+      if (mpz_cmp (p, gfc_integer_kinds[i].pedantic_min_int) < 0)
+        result = ARITH_ASYMMETRIC;
+    }
+
   if (mpz_cmp (p, gfc_integer_kinds[i].min_int) < 0
       || mpz_cmp (p, gfc_integer_kinds[i].max_int) > 0)
     result = ARITH_OVERFLOW;
@@ -529,7 +549,7 @@ gfc_range_check (gfc_expr * e)
     default:
       gfc_internal_error ("gfc_range_check(): Bad type");
     }
-
+    
   return rc;
 }
 
@@ -582,6 +602,12 @@ gfc_arith_uminus (gfc_expr * op1, gfc_ex
       rc = ARITH_OK;
       *resultp = result;
     }
+  else if (rc == ARITH_ASYMMETRIC)
+    {
+      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
@@ -631,6 +657,12 @@ gfc_arith_plus (gfc_expr * op1, gfc_expr
       rc = ARITH_OK;
       *resultp = result;
     }
+  else if (rc == ARITH_ASYMMETRIC)
+    {
+      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
@@ -680,6 +712,12 @@ gfc_arith_minus (gfc_expr * op1, gfc_exp
       rc = ARITH_OK;
       *resultp = result;
     }
+  else if (rc == ARITH_ASYMMETRIC)
+    {
+      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
@@ -743,6 +781,12 @@ gfc_arith_times (gfc_expr * op1, gfc_exp
       rc = ARITH_OK;
       *resultp = result;
     }
+  else if (rc == ARITH_ASYMMETRIC)
+    {
+      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
@@ -839,6 +883,12 @@ gfc_arith_divide (gfc_expr * op1, gfc_ex
       rc = ARITH_OK;
       *resultp = result;
     }
+  else if (rc == ARITH_ASYMMETRIC)
+    {
+      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
@@ -1029,11 +1079,17 @@ gfc_arith_power (gfc_expr * op1, gfc_exp
       rc = ARITH_OK;
       *resultp = result;
     }
+  else if (rc == ARITH_ASYMMETRIC)
+    {
+      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;
-
+  
   return rc;
 }
 
@@ -1932,9 +1988,16 @@ gfc_int2int (gfc_expr * src, int kind)
   if ((rc = gfc_check_integer_range (result->value.integer, kind))
       != ARITH_OK)
     {
-      arith_error (rc, &src->ts, &result->ts, &src->where);
-      gfc_free_expr (result);
-      return NULL;
+      if (rc == ARITH_ASYMMETRIC)
+        {
+          gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
+        }
+      else
+        {
+          arith_error (rc, &src->ts, &result->ts, &src->where);
+          gfc_free_expr (result);
+          return NULL;
+        }
     }
 
   return result;
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.39
diff -u -3 -p -r1.39 gfortran.h
--- gfortran.h	4 Oct 2004 21:30:26 -0000	1.39
+++ gfortran.h	21 Oct 2004 23:34:05 -0000
@@ -185,7 +185,7 @@ extern mstring intrinsic_operators[];
 /* Arithmetic results.  */
 typedef enum
 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
-  ARITH_DIV0, ARITH_0TO0, ARITH_INCOMMENSURATE
+  ARITH_DIV0, ARITH_0TO0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC
 }
 arith;
 
@@ -1100,7 +1100,7 @@ gfc_expr;
 typedef struct
 {
   /* Values really representable by the target.  */
-  mpz_t huge, min_int, max_int;
+  mpz_t huge, pedantic_min_int, min_int, max_int;
 
   int kind, radix, digits, bit_size, range;