A few fixes, add unsigned truncation warning.

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 849fa784241d35ca4ef1174a2d446625e3344354..1b304b114dd80d1457f5a9a70dcbf5e7c273449d 100644 (file)
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -86,7 +86,7 @@ gfc_set_model (mpfr_t x)
 /* Given an arithmetic error code, return a pointer to a string that
    explains the error.  */
 
-static const char *
+const char *
 gfc_arith_error (arith code)
 {
   const char *p;
@@ -121,7 +121,12 @@ gfc_arith_error (arith code)
     case ARITH_INVALID_TYPE:
       p = G_("Invalid type in arithmetic operation at %L");
       break;
-
+    case ARITH_UNSIGNED_TRUNCATED:
+      p = G_("Unsigned constant truncated at %L");
+      break;
+    case ARITH_UNSIGNED_NEGATIVE:
+      p = G_("Truncated negative unsigned constant at %L");
+      break;
     default:
       gfc_internal_error ("gfc_arith_error(): Bad error code");
     }
@@ -208,13 +213,21 @@ gfc_arith_init_1 (void)
     {
       for (uint_info = gfc_unsigned_kinds; uint_info->kind != 0; uint_info++)
        {
+         /* UNSIGNED is radix 2.  */
+         gcc_assert (uint_info->radix == 2);
          /* Huge.  */
          mpz_init (uint_info->huge);
-         mpz_set_ui (uint_info->huge, uint_info->radix);
+         mpz_set_ui (uint_info->huge, 2);
          mpz_pow_ui (uint_info->huge, uint_info->huge, uint_info->digits);
+         mpz_sub_ui (uint_info->huge, uint_info->huge, 1);
 
-         /* UNSIGNED is radix 2.  */
-         gcc_assert (uint_info->radix == 2);
+         /* int_min - the smallest number we can reasonably convert from.  */
+
+         mpz_init (uint_info->int_min);
+         mpz_set_ui (uint_info->int_min, 2);
+         mpz_pow_ui (uint_info->int_min, uint_info->int_min,
+                     uint_info->digits - 1);
+         mpz_neg (uint_info->int_min, uint_info->int_min);
 
          /* Range.  */
          mpfr_set_z (a, uint_info->huge, GFC_RND_MODE);
@@ -367,6 +380,24 @@ gfc_check_integer_range (mpz_t p, int kind)
   return result;
 }
 
+/* Same as above.  */
+arith
+gfc_check_unsigned_range (mpz_t p, int kind)
+{
+  arith result;
+  int i;
+
+  i = gfc_validate_kind (BT_UNSIGNED, kind, false);
+  result = ARITH_OK;
+
+  if (mpz_cmp (p, gfc_unsigned_kinds[i].int_min) < 0)
+    result = ARITH_UNSIGNED_TRUNCATED;
+
+  if (mpz_cmp (p, gfc_unsigned_kinds[i].huge) > 0)
+    result = ARITH_UNSIGNED_TRUNCATED;
+
+  return result;
+}
 
 /* Given a real and a kind, make sure that the real lies within the
    range of the kind.  Returns ARITH_OK, ARITH_OVERFLOW or
@@ -564,6 +595,10 @@ gfc_range_check (gfc_expr *e)
       rc = gfc_check_integer_range (e->value.integer, e->ts.kind);
       break;
 
+    case BT_UNSIGNED:
+      rc = gfc_check_unsigned_range (e->value.integer, e->ts.kind);
+      break;
+
     case BT_REAL:
       rc = gfc_check_real_range (e->value.real, e->ts.kind);
       if (rc == ARITH_UNDERFLOW)
@@ -653,6 +688,7 @@ gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp)
 {
   gfc_expr *result;
   arith rc;
+  int k;
 
   result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
 
@@ -662,6 +698,22 @@ gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp)
       mpz_neg (result->value.integer, op1->value.integer);
       break;
 
+    case BT_UNSIGNED:
+      {
+       arith neg_rc;
+       mpz_neg (result->value.integer, op1->value.integer);
+       k = gfc_validate_kind (BT_UNSIGNED, op1->ts.kind, false);
+       neg_rc = gfc_range_check (result);
+       if (neg_rc != ARITH_OK)
+         gfc_warning (0, gfc_arith_error (neg_rc), &result->where);
+
+       mpz_and (result->value.integer, result->value.integer,
+                gfc_unsigned_kinds[k].huge);
+       if (pedantic)
+         rc = neg_rc;
+      }
+      break;
+
     case BT_REAL:
       mpfr_neg (result->value.real, op1->value.real, GFC_RND_MODE);
       break;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1e3262f97bf2631e06f0a166a9efa69c826838ff..b241e2834b9b7dc5def30dbdcd8199428417a766 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -227,7 +227,8 @@ enum gfc_intrinsic_op
 enum arith
 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
   ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
-  ARITH_WRONGCONCAT, ARITH_INVALID_TYPE, ARITH_NOT_REDUCED
+  ARITH_WRONGCONCAT, ARITH_INVALID_TYPE, ARITH_NOT_REDUCED,
+  ARITH_UNSIGNED_TRUNCATED, ARITH_UNSIGNED_NEGATIVE
 };
 
 /* Statements.  */
@@ -2744,7 +2745,7 @@ extern gfc_integer_info gfc_integer_kinds[];
 
 typedef struct
 {
-  mpz_t huge;
+  mpz_t huge, int_min;
 
   int kind, radix, digits, bit_size, range;
 
@@ -3470,7 +3471,9 @@ void gfc_errors_to_warnings (bool);
 void gfc_arith_init_1 (void);
 void gfc_arith_done_1 (void);
 arith gfc_check_integer_range (mpz_t p, int kind);
+arith gfc_check_unsigned_range (mpz_t p, int kind);
 bool gfc_check_character_range (gfc_char_t, int);
+const char *gfc_arith_error (arith);
 
 extern bool gfc_seen_div0;
 
@@ -4112,7 +4115,7 @@ void gfc_convert_mpz_to_signed (mpz_t, int);
 gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
 bool gfc_is_constant_array_expr (gfc_expr *);
 bool gfc_is_size_zero_array (gfc_expr *);
-void gfc_convert_mpz_to_unsigned (mpz_t, int, bool check = true);
+void gfc_convert_mpz_to_unsigned (mpz_t, int, bool sign = true);
 
 /* trans-array.cc  */
 

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 63b0bcf6784dedf5b5ad1037cefffaf4114fac40..24bfdb55e41d96117ed0f76aade3c4db1b1e3542 100644 (file)
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -218,6 +218,7 @@ convert_unsigned (const char *buffer, int kind, int radix, locus *where)
   gfc_expr *e;
   const char *t;
   int k;
+  arith rc;
 
   e = gfc_get_constant_expr (BT_UNSIGNED, kind, where);
   /* A leading plus is allowed, but not by mpz_set_str.  */
@@ -229,6 +230,12 @@ convert_unsigned (const char *buffer, int kind, int radix, locus *where)
   mpz_set_str (e->value.integer, t, radix);
 
   k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+
+  /* XXX Maybe move this somewhere else.  */
+  rc = gfc_range_check (e);
+  if (rc != ARITH_OK)
+    gfc_warning (0, gfc_arith_error (rc), &e->where);
+
   gfc_convert_mpz_to_unsigned (e->value.integer, gfc_unsigned_kinds[k].bit_size,
                               false);
 

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index a8c9397edf9744fa8662dacd870fb7d4ca8bddde..919d9d560e1116889ec8734240c3361e7757c7fb 100644 (file)
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -148,7 +148,7 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
    be accomplished by masking out the high bits.  */
 
 void
-gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize, bool check)
+gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize, bool sign)
 {
   mpz_t mask;
 
@@ -156,7 +156,7 @@ gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize, bool check)
     {
       /* Confirm that no bits above the signed range are unset if we
         are doing range checking.  */
-      if (flag_range_check != 0)
+      if (sign && flag_range_check != 0)
        gcc_assert (mpz_scan0 (x, bitsize-1) == ULONG_MAX);
 
       mpz_init_set_ui (mask, 1);
@@ -171,7 +171,7 @@ gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize, bool check)
     {
       /* Confirm that no bits above the signed range are set if we
         are doing range checking.  */
-      if (check && flag_range_check != 0)
+      if (sign && flag_range_check != 0)
        gcc_assert (mpz_scan1 (x, bitsize-1) == ULONG_MAX);
     }
 }

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index a00dc80bf596e35a6ce04cef7bba8f7e09d70e0d..552e46dcc8caee3f58387033fb6c21d4714227c0 100644 (file)
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1038,18 +1038,6 @@ gfc_init_types (void)
       PUSH_TYPE (name_buf, type);
     }
 
-  if (flag_unsigned)
-    {
-      for (index = 0; gfc_unsigned_kinds[index].kind != 0;++index)
-       {
-         type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]);
-         gfc_unsigned_types[index] = type;
-         snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d",
-                   gfc_integer_kinds[index].kind);
-         PUSH_TYPE (name_buf, type);
-       }
-    }
-
   for (index = 0; gfc_logical_kinds[index].kind != 0; ++index)
     {
       type = gfc_build_logical_type (&gfc_logical_kinds[index]);
@@ -1092,6 +1080,40 @@ gfc_init_types (void)
     }
   gfc_character1_type_node = gfc_character_types[0];
 
+  /* The middle end only recognizes a single unsigned type.  For
+     compatibility of existing test cases, let's just use the
+     character type.  The reader of tree dumps is expected to be able
+     to deal with this.  */
+
+  if (flag_unsigned)
+    {
+      for (index = 0; gfc_unsigned_kinds[index].kind != 0;++index)
+       {
+         int index_char = -1;
+         for (int i=0; gfc_character_kinds[i].kind != 0; i++)
+           {
+             if (gfc_character_kinds[i].bit_size ==
+                 gfc_unsigned_kinds[index].bit_size)
+               {
+                 index_char = i;
+                 break;
+               }
+           }
+         if (index_char > 0)
+           {
+             gfc_unsigned_types[index] = gfc_character_types[index_char];
+           }
+         else
+           {
+             type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]);
+             gfc_unsigned_types[index] = type;
+             snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)",
+                       gfc_integer_kinds[index].kind);
+             PUSH_TYPE (name_buf, type);
+           }
+       }
+    }
+
   PUSH_TYPE ("byte", unsigned_char_type_node);
   PUSH_TYPE ("void", void_type_node);
 
@@ -1153,8 +1175,8 @@ gfc_get_int_type (int kind)
 tree
 gfc_get_unsigned_type (int kind)
 {
-  int index = gfc_validate_kind (BT_INTEGER, kind, true);
-  return index < 0 ? 0 : gfc_integer_types[index];
+  int index = gfc_validate_kind (BT_UNSIGNED, kind, true);
+  return index < 0 ? 0 : gfc_unsigned_types[index];
 }
 
 tree

diff --git a/gcc/testsuite/gfortran.dg/unsigned_3.f90 b/gcc/testsuite/gfortran.dg/unsigned_3.f90
new file mode 100644 (file)
index 0000000..7d5b4d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-funsigned" }
+! Test that overflow warned about.
+program main
+  unsigned(1) :: u
+  u = 256u_1 ! { dg-warning "Unsigned constant truncated" }
+  u = -127u_1
+  u = 255u_1
+  u = -129u_1 ! { dg-warning "Unsigned constant truncated" }
+end