Add compile-time version of selected_unsigned_kind.

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index a7b8af7779d18531e8cf94e09f144f649be8bc31..849fa784241d35ca4ef1174a2d446625e3344354 100644 (file)
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -160,6 +160,7 @@ void
 gfc_arith_init_1 (void)
 {
   gfc_integer_info *int_info;
+  gfc_unsigned_info *uint_info;
   gfc_real_info *real_info;
   mpfr_t a, b;
   int i;
@@ -202,6 +203,28 @@ gfc_arith_init_1 (void)
       int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
     }
 
+  /* Similar, for UNSIGNED.  */
+  if (flag_unsigned)
+    {
+      for (uint_info = gfc_unsigned_kinds; uint_info->kind != 0; uint_info++)
+       {
+         /* Huge.  */
+         mpz_init (uint_info->huge);
+         mpz_set_ui (uint_info->huge, uint_info->radix);
+         mpz_pow_ui (uint_info->huge, uint_info->huge, uint_info->digits);
+
+         /* UNSIGNED is radix 2.  */
+         gcc_assert (uint_info->radix == 2);
+
+         /* Range.  */
+         mpfr_set_z (a, uint_info->huge, GFC_RND_MODE);
+         mpfr_log10 (a, a, GFC_RND_MODE);
+         mpfr_trunc (a,a);
+         uint_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
+       }
+
+    }
+
   mpfr_clear (a);
 
   for (real_info = gfc_real_kinds; real_info->kind != 0; real_info++)

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index e90a99df1e2b7239f2a9190c1c74cba20c060218..25ae21a8e5f8915c51fa1214a47447f027021167 100644 (file)
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5012,7 +5012,6 @@ gfc_check_selected_int_kind (gfc_expr *r)
   return true;
 }
 
-
 bool
 gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
 {

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 545a64dba239179c1f82a49fc94059e9b71d3c02..b47a84ae1a937be59f145ccfdbb74d3532d89a98 100644 (file)
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -700,7 +700,6 @@ gfc_extract_int (gfc_expr *expr, int *result, int report_error)
   return false;
 }
 
-
 /* Same as gfc_extract_int, but use a HWI.  */
 
 bool

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f922bf3bb991c1bface0796fc3583ed788ad89b6..d7bbcf6cdcde2b45f613dd788577598467cd9b0c 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -677,6 +677,7 @@ enum gfc_isym_id
   GFC_ISYM_STOPPED_IMAGES,
   GFC_ISYM_STORAGE_SIZE,
   GFC_ISYM_STRIDE,
+  GFC_ISYM_SU_KIND,
   GFC_ISYM_SUM,
   GFC_ISYM_SYMLINK,
   GFC_ISYM_SYMLNK,

diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 40f4c4f4b0bc5e1c24f9d008ceecaf2c4e144280..9074fe3c186b54a07eec45d7a67581edfa98f3d6 100644 (file)
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -2952,6 +2952,16 @@ add_functions (void)
 
   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
 
+  if (flag_unsigned)
+    {
+
+      add_sym_1 ("selected_unsigned_kind", GFC_ISYM_SU_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
+                BT_INTEGER, di, GFC_STD_GNU, gfc_check_selected_int_kind,
+                gfc_simplify_selected_unsigned_kind, NULL, r, BT_INTEGER, di, REQUIRED);
+
+      make_generic ("selected_unsigned_kind", GFC_ISYM_SU_KIND, GFC_STD_GNU);
+    }
+
   add_sym_1 ("selected_logical_kind", GFC_ISYM_SL_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
             GFC_STD_F2023, /* it has the same requirements */ gfc_check_selected_int_kind,
             gfc_simplify_selected_logical_kind, NULL, r, BT_INTEGER, di, REQUIRED);

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 2c287caa6ad59af38032af94d3f16b70332e0bac..bfd0ac4c7f0130276b9c6dd8327c77a6f4575c66 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -399,6 +399,7 @@ gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
+gfc_expr *gfc_simplify_selected_unsigned_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_logical_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 18c9088ef667649ed06846e7d5fe2eb7cf59f601..b96f5ee713e31de61facb9f3054ecbd23c74aba3 100644 (file)
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -7404,6 +7404,29 @@ gfc_simplify_selected_int_kind (gfc_expr *e)
   return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
 }
 
+/* Same as above, but with unsigneds.  */
+
+gfc_expr *
+gfc_simplify_selected_unsigned_kind (gfc_expr *e)
+{
+  int i, kind, range;
+
+  if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range))
+    return NULL;
+
+  kind = INT_MAX;
+
+  for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
+    if (gfc_unsigned_kinds[i].range >= range
+       && gfc_unsigned_kinds[i].kind < kind)
+      kind = gfc_unsigned_kinds[i].kind;
+
+  if (kind == INT_MAX)
+    kind = -1;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
+}
+
 
 gfc_expr *
 gfc_simplify_selected_logical_kind (gfc_expr *e)