Added UINT intrinsic.

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 73e0610689e6d3d8907455eb8f85f1cb8620c1bc..b270ae8741ff6e55d23fd69a7c29323af19015a3 100644 (file)
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1206,6 +1206,7 @@ gfc_compare_expr (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
   switch (op1->ts.type)
     {
     case BT_INTEGER:
+    case BT_UNSIGNED:
       rc = mpz_cmp (op1->value.integer, op2->value.integer);
       break;
 
@@ -1795,7 +1796,7 @@ eval_intrinsic (gfc_intrinsic_op op,
     gcc_fallthrough ();
     /* Numeric binary  */
     case INTRINSIC_POWER:
-      if (flag_unsigned)
+      if (flag_unsigned && op == INTRINSIC_POWER)
        {
          if (op1->ts.type == BT_UNSIGNED || op2->ts.type == BT_UNSIGNED)
            goto runtime;
@@ -2531,6 +2532,58 @@ gfc_real2int (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert real to unsigned.  */
+
+gfc_expr *
+gfc_real2uint (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+  bool did_warn = false;
+  int k;
+
+  if (src->ts.type != BT_REAL)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &src->where);
+
+  gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where);
+  if ((rc = gfc_check_unsigned_range (result->value.integer, kind)) != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+  mpz_and (result->value.integer, result->value.integer,
+          gfc_unsigned_kinds[k].huge);
+
+  /* If there was a fractional part, warn about this.  */
+
+  if (warn_conversion)
+    {
+      mpfr_t f;
+      mpfr_init (f);
+      mpfr_frac (f, src->value.real, GFC_RND_MODE);
+      if (mpfr_cmp_si (f, 0) != 0)
+       {
+         gfc_warning_now (OPT_Wconversion, "Change of value in conversion "
+                          "from %qs to %qs at %L", gfc_typename (&src->ts),
+                          gfc_typename (&result->ts), &src->where);
+         did_warn = true;
+       }
+      mpfr_clear (f);
+    }
+  if (!did_warn && warn_conversion_extra)
+    {
+      gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+                      "at %L", gfc_typename (&src->ts),
+                      gfc_typename (&result->ts), &src->where);
+    }
+
+  return result;
+}
 
 /* Convert real to real.  */
 
@@ -2713,6 +2766,75 @@ gfc_complex2int (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert complex to integer.  */
+
+gfc_expr *
+gfc_complex2uint (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+  bool did_warn = false;
+  int k;
+
+  if (src->ts.type != BT_COMPLEX)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &src->where);
+
+  gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex),
+                  &src->where);
+
+  if ((rc = gfc_check_unsigned_range (result->value.integer, kind)) != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+  mpz_and (result->value.integer, result->value.integer,
+          gfc_unsigned_kinds[k].huge);
+
+  if (warn_conversion || warn_conversion_extra)
+    {
+      int w = warn_conversion ? OPT_Wconversion : OPT_Wconversion_extra;
+
+      /* See if we discarded an imaginary part.  */
+      if (mpfr_cmp_si (mpc_imagref (src->value.complex), 0) != 0)
+       {
+         gfc_warning_now (w, "Non-zero imaginary part discarded "
+                          "in conversion from %qs to %qs at %L",
+                          gfc_typename(&src->ts), gfc_typename (&result->ts),
+                          &src->where);
+         did_warn = true;
+       }
+
+      else {
+       mpfr_t f;
+
+       mpfr_init (f);
+       mpfr_frac (f, src->value.real, GFC_RND_MODE);
+       if (mpfr_cmp_si (f, 0) != 0)
+         {
+           gfc_warning_now (w, "Change of value in conversion from "
+                            "%qs to %qs at %L", gfc_typename (&src->ts),
+                            gfc_typename (&result->ts), &src->where);
+           did_warn = true;
+         }
+       mpfr_clear (f);
+      }
+
+      if (!did_warn && warn_conversion_extra)
+       {
+         gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+                          "at %L", gfc_typename (&src->ts),
+                          gfc_typename (&result->ts), &src->where);
+       }
+    }
+
+  return result;
+}
+
 
 /* Convert complex to real.  */
 
@@ -2887,6 +3009,22 @@ gfc_log2int (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert logical to unsigned.  */
+
+gfc_expr *
+gfc_log2uint (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  if (src->ts.type != BT_LOGICAL)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &src->where);
+  mpz_set_si (result->value.integer, src->value.logical);
+
+  return result;
+}
+
 
 /* Convert integer to logical.  */
 
@@ -2904,6 +3042,22 @@ gfc_int2log (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert unsigned to logical.  */
+
+gfc_expr *
+gfc_uint2log (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  if (src->ts.type != BT_UNSIGNED)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+  result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);
+
+  return result;
+}
+
 /* Convert character to character. We only use wide strings internally,
    so we only set the kind.  */
 

diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
index e796d4dac2935a2a690510e32490e44516719795..95db799167ae848762b66853afc081b3cae545ef 100644 (file)
--- a/gcc/fortran/arith.h
+++ b/gcc/fortran/arith.h
@@ -69,14 +69,18 @@ gfc_expr *gfc_uint2int (gfc_expr *, int);
 gfc_expr *gfc_uint2real (gfc_expr *, int);
 gfc_expr *gfc_uint2complex (gfc_expr *, int);
 gfc_expr *gfc_real2int (gfc_expr *, int);
+gfc_expr *gfc_real2uint (gfc_expr *, int);
 gfc_expr *gfc_real2real (gfc_expr *, int);
 gfc_expr *gfc_real2complex (gfc_expr *, int);
 gfc_expr *gfc_complex2int (gfc_expr *, int);
+gfc_expr *gfc_complex2uint (gfc_expr *, int);
 gfc_expr *gfc_complex2real (gfc_expr *, int);
 gfc_expr *gfc_complex2complex (gfc_expr *, int);
 gfc_expr *gfc_log2log (gfc_expr *, int);
 gfc_expr *gfc_log2int (gfc_expr *, int);
+gfc_expr *gfc_log2uint (gfc_expr *, int);
 gfc_expr *gfc_int2log (gfc_expr *, int);
+gfc_expr *gfc_uint2log (gfc_expr *, int);
 gfc_expr *gfc_hollerith2int (gfc_expr *, int);
 gfc_expr *gfc_hollerith2real (gfc_expr *, int);
 gfc_expr *gfc_hollerith2complex (gfc_expr *, int);

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 25ae21a8e5f8915c51fa1214a47447f027021167..b07de09b6671064f0d7be61fedc479553bdafdce 100644 (file)
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -465,7 +465,31 @@ gfc_boz2int (gfc_expr *x, int kind)
   return true;
 }
 
+/* Same as above for UNSIGNED, but much simpler because
+   of wraparound.  */
+bool
+gfc_boz2uint (gfc_expr *x, int kind)
+{
+  int k;
+  if (!is_boz_constant(x))
+    return false;
 
+  mpz_init (x->value.integer);
+  mpz_set_str (x->value.integer, x->boz.str, x->boz.rdx);
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+  if (mpz_cmp (x->value.integer, gfc_unsigned_kinds[k].huge) > 0)
+    {
+      gfc_warning (0, _("BOZ contstant truncated at %L"), &x->where);
+      mpz_and (x->value.integer, x->value.integer, gfc_unsigned_kinds[k].huge);
+    }
+
+  /* Clear boz info.  */
+  x->boz.rdx = 0;
+  x->boz.len = 0;
+  free (x->boz.str);
+
+  return true;
+}
 /* Make sure an expression is a scalar.  */
 
 static bool
@@ -3240,6 +3264,29 @@ gfc_check_int (gfc_expr *x, gfc_expr *kind)
   return true;
 }
 
+bool
+gfc_check_uint (gfc_expr *x, gfc_expr *kind)
+{
+
+  if (!flag_unsigned)
+    {
+      gfc_error ("UINT intrinsic only valid with %<-funsigned%> at %L",
+                &x->where);
+      return false;
+    }
+
+  /* BOZ is dealt within simplify_uint*.  */
+  if (x->ts.type == BT_BOZ)
+    return true;
+
+  if (!numeric_check (x, 0))
+    return false;
+
+  if (!kind_check (kind, 1, BT_INTEGER))
+    return false;
+
+  return true;
+}
 
 bool
 gfc_check_intconv (gfc_expr *x)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b241e2834b9b7dc5def30dbdcd8199428417a766..e3567cd0d18f671100a407ac1ca8397bce509d14 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -710,8 +710,8 @@ enum gfc_isym_id
 
   /* Add this at the end, so maybe the module format
      remains compatible.  */
-  GFC_ISYM_SU_KIND
-
+  GFC_ISYM_SU_KIND,
+  GFC_ISYM_UINT,
 };
 
 enum init_local_logical
@@ -4028,6 +4028,7 @@ bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
 bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
                                      size_t*, size_t*, size_t*);
 bool gfc_boz2int (gfc_expr *, int);
+bool gfc_boz2uint (gfc_expr *, int);
 bool gfc_boz2real (gfc_expr *, int);
 bool gfc_invalid_boz (const char *, locus *);
 bool gfc_invalid_null_arg (gfc_expr *);

diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 65ca14af67657e4832ffc20ce7b9726a748a6594..86f5ce9f1e326d31b96a70d15afb3a674a892d35 100644 (file)
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -2262,6 +2262,12 @@ add_functions (void)
 
   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
 
+  add_sym_2 ("uint", GFC_ISYM_UINT, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNSIGNED, di, GFC_STD_GNU,
+            gfc_check_uint, gfc_simplify_uint, gfc_resolve_uint,
+            a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("uint", GFC_ISYM_UINT, GFC_STD_GNU);
+
   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
             GFC_STD_F95,
             gfc_check_iand_ieor_ior, gfc_simplify_ior, gfc_resolve_ior,

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index bfd0ac4c7f0130276b9c6dd8327c77a6f4575c66..fcb2733ddec8b2ca3172bdb11ddfc05f59e6101f 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -98,6 +98,7 @@ bool gfc_check_image_status (gfc_expr *, gfc_expr *);
 bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_int (gfc_expr *, gfc_expr *);
 bool gfc_check_intconv (gfc_expr *);
+bool gfc_check_uint (gfc_expr *, gfc_expr *);
 bool gfc_check_irand (gfc_expr *);
 bool gfc_check_is_contiguous (gfc_expr *);
 bool gfc_check_isatty (gfc_expr *);
@@ -324,6 +325,7 @@ gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_image_status (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_uint (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int2 (gfc_expr *);
 gfc_expr *gfc_simplify_int8 (gfc_expr *);
 gfc_expr *gfc_simplify_long (gfc_expr *);
@@ -531,6 +533,7 @@ void gfc_resolve_iall (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_iany (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_idnint (gfc_expr *, gfc_expr *);
 void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_uint (gfc_expr *, gfc_expr*, gfc_expr *);
 void gfc_resolve_int2 (gfc_expr *, gfc_expr *);
 void gfc_resolve_int8 (gfc_expr *, gfc_expr *);
 void gfc_resolve_long (gfc_expr *, gfc_expr *);

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index c63a4a8d38cd95afff750976c4c2bcd4fe519fa0..845c99f18ddf24504a6cc88a7a89b5bc345ec565 100644 (file)
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -1345,6 +1345,18 @@ gfc_resolve_int (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
                      gfc_type_abi_kind (&a->ts));
 }
 
+void
+gfc_resolve_uint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_UNSIGNED;
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__uint_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type),
+                     gfc_type_abi_kind (&a->ts));
+}
+
 
 void
 gfc_resolve_int2 (gfc_expr *f, gfc_expr *a)

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 8d622702b4ad7605c64604d0ebfe6d6b203705b7..0f4f8f506492f8d5db565fb14823242601310fb8 100644 (file)
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3629,7 +3629,6 @@ done:
   return range_check (result, "INDEX");
 }
 
-
 static gfc_expr *
 simplify_intconv (gfc_expr *e, int kind, const char *name)
 {
@@ -3740,6 +3739,36 @@ gfc_simplify_idint (gfc_expr *e)
   return range_check (result, "IDINT");
 }
 
+gfc_expr *
+gfc_simplify_uint (gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *result = NULL;
+  int kind;
+
+  kind = get_kind (BT_INTEGER, k, "INT", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  /* Convert BOZ to integer, and return without range checking.  */
+  if (e->ts.type == BT_BOZ)
+    {
+      if (!gfc_boz2int (e, kind))
+       return NULL;
+      result = gfc_copy_expr (e);
+      return result;
+    }
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_convert_constant (e, BT_UNSIGNED, kind);
+
+  if (result == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  return range_check (result, "UINT");
+}
+
 
 gfc_expr *
 gfc_simplify_ior (gfc_expr *x, gfc_expr *y)
@@ -8850,6 +8879,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
        case BT_COMPLEX:
          f = gfc_uint2complex;
          break;
+       case BT_LOGICAL:
+         f = gfc_uint2log;
+         break;
        default:
          goto oops;
        }
@@ -8861,6 +8893,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
        case BT_INTEGER:
          f = gfc_real2int;
          break;
+       case BT_UNSIGNED:
+         f = gfc_real2uint;
+         break;
        case BT_REAL:
          f = gfc_real2real;
          break;
@@ -8878,6 +8913,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
        case BT_INTEGER:
          f = gfc_complex2int;
          break;
+       case BT_UNSIGNED:
+         f = gfc_complex2uint;
+         break;
        case BT_REAL:
          f = gfc_complex2real;
          break;
@@ -8896,6 +8934,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
        case BT_INTEGER:
          f = gfc_log2int;
          break;
+       case BT_UNSIGNED:
+         f = gfc_log2uint;
+         break;
        case BT_LOGICAL:
          f = gfc_log2log;
          break;
@@ -8911,6 +8952,11 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
          f = gfc_hollerith2int;
          break;
 
+         /* Hollerith is for legacy code, we do not currently support
+            converting this to UNSIGNED.  */
+       case BT_UNSIGNED:
+         goto oops;
+
        case BT_REAL:
          f = gfc_hollerith2real;
          break;
@@ -8939,6 +8985,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
          f = gfc_character2int;
          break;
 
+       case BT_UNSIGNED:
+         goto oops;
+
        case BT_REAL:
          f = gfc_character2real;
          break;

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6d703a935edfb584044efac31e581..2acfc8670791fb77428e60b9d2e61eb8d13655d2 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -10853,6 +10853,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_INT2:
     case GFC_ISYM_INT8:
     case GFC_ISYM_LONG:
+    case GFC_ISYM_UINT:
       gfc_conv_intrinsic_int (se, expr, RND_TRUNC);
       break;
 

diff --git a/gcc/testsuite/gfortran.dg/unsigned_1.f90 b/gcc/testsuite/gfortran.dg/unsigned_1.f90
index ed1a6eed937e6acef941c07106c5d78950ac04df..cf5c767456c889d92ce7516b42a34beec1361473 100644 (file)
--- a/gcc/testsuite/gfortran.dg/unsigned_1.f90
+++ b/gcc/testsuite/gfortran.dg/unsigned_1.f90
@@ -10,7 +10,7 @@ program memain
   u = 1u
   v = 42u
   if (u + v /= 43u) then
-     stop 1
+     error stop 1
   end if
-  if (u1 /= 1 .or. u2 /= 2 .or. u4 /= 4 .or. u8 /= 8) stop 2
+  if (u1 /= 1 .or. u2 /= 2 .or. u4 /= 4 .or. u8 /= 8) error stop 2
 end program memain

diff --git a/gcc/testsuite/gfortran.dg/unsigned_2.f90 b/gcc/testsuite/gfortran.dg/unsigned_2.f90
index e55e0f51a6df2e4d59c99a8618f44c009b272c9d..8daf0d518b8e65e3f6e6352b924618bec78445c4 100644 (file)
--- a/gcc/testsuite/gfortran.dg/unsigned_2.f90
+++ b/gcc/testsuite/gfortran.dg/unsigned_2.f90
@@ -10,11 +10,11 @@ program main
   write (10,*) uw,-1
   rewind 10
   read (10,*) ur,vr
-  if (ur /= 10u .or. vr /= 4294967295u) stop 1
+  if (ur /= 10u .or. vr /= 4294967295u) error stop 1
   rewind 10
   write (10,*) 17179869184u_8
   rewind 10
   read (10,*) u8
-  if (u8 /= 17179869184u_8) stop 2
+  if (u8 /= 17179869184u_8) error stop 2
 end program main
   

diff --git a/gcc/testsuite/gfortran.dg/unsigned_4.f90 b/gcc/testsuite/gfortran.dg/unsigned_4.f90
index 495523d919d3093c3721d08f59fb5363325c722f..46b08a3e81f62ebacfcd114b51187238063d4f73 100644 (file)
--- a/gcc/testsuite/gfortran.dg/unsigned_4.f90
+++ b/gcc/testsuite/gfortran.dg/unsigned_4.f90
@@ -9,7 +9,7 @@ program main
   write (10,'(I4)') -1
   rewind 10
   read (10,'(I4)') u
-  if (u /= 1u) stop 1
+  if (u /= 1u) error stop 1
   read (10,'(I4)') u
-  if (u /= 4294967295u) stop 2
+  if (u /= 4294967295u) error stop 2
 end program main

diff --git a/gcc/testsuite/gfortran.dg/unsigned_5.f90 b/gcc/testsuite/gfortran.dg/unsigned_5.f90
index 5fbd1b4150b9015652bba7ecf7c667d04d1efdd1..b8b956ecdf671a2b5b923689824f697282b528d5 100644 (file)
--- a/gcc/testsuite/gfortran.dg/unsigned_5.f90
+++ b/gcc/testsuite/gfortran.dg/unsigned_5.f90
@@ -42,7 +42,7 @@ program main
   rewind 10
   do i=1,n_int
      read (10,*) vi
-     if (vi /= ires(i)) stop 1
+     if (vi /= ires(i)) error stop 1
   end do
 
   rewind 10
@@ -69,7 +69,7 @@ program main
   rewind 10
   do i=1,n_int
      read (10,*) vi
-     if (vi /= ires(i)) stop 2
+     if (vi /= ires(i)) error stop 2
   end do
 
   rewind 10
@@ -85,7 +85,7 @@ program main
   rewind 10
   do i=1, n_real
      read (10, *) vr
-     if (vr /= rres(i)) stop 3
+     if (vr /= rres(i)) error stop 3
   end do
 
   rewind 10
@@ -101,7 +101,7 @@ program main
   rewind 10
   do i=1, n_real
      read (10, *) vr
-     if (vr /= rres(i)) stop 4
+     if (vr /= rres(i)) error stop 4
   end do
 
   rewind 10
@@ -117,7 +117,7 @@ program main
   rewind 10
   do i=1,n_real
      read (10, *) vc
-     if (real(vc) /= rres(i)) stop 5
-     if (aimag(vc) /= rres(i)) stop 6
+     if (real(vc) /= rres(i)) error stop 5
+     if (aimag(vc) /= rres(i)) error stop 6
   end do
 end program main

diff --git a/gcc/testsuite/gfortran.dg/unsigned_6.f90 b/gcc/testsuite/gfortran.dg/unsigned_6.f90
new file mode 100644 (file)
index 0000000..5caffee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_6.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test the uint intrinsic.
+program main
+  implicit none
+  integer :: i
+  real :: r
+  complex :: c
+  if (1u /= uint(1)) error stop 1
+  if (2u /= uint(2.0)) error stop 2
+  if (3u /= uint((3.2,0.))) error stop 3
+
+  i = 4
+  if (uint(i) /= 4u) error stop 4
+  r = 5.2
+  if (uint(r) /= 5u) error stop 5
+  c = (6.2,-1.2)
+  if (uint(c) /= 6u) error stop 6
+end program main