https://gcc.gnu.org/g:ee47e28302a203228511de36bffeef3b7d7e14ef
commit ee47e28302a203228511de36bffeef3b7d7e14ef
Author: Thomas Koenig <tkoe...@gcc.gnu.org>
Date: Sun Aug 4 12:54:41 2024 +0200
Added UINT intrinsic.
Diff:
---
gcc/fortran/arith.cc | 156 ++++++++++++++++++++++++++++++-
gcc/fortran/arith.h | 4 +
gcc/fortran/check.cc | 47 ++++++++++
gcc/fortran/gfortran.h | 5 +-
gcc/fortran/intrinsic.cc | 6 ++
gcc/fortran/intrinsic.h | 3 +
gcc/fortran/iresolve.cc | 12 +++
gcc/fortran/simplify.cc | 51 +++++++++-
gcc/fortran/trans-intrinsic.cc | 1 +
gcc/testsuite/gfortran.dg/unsigned_1.f90 | 4 +-
gcc/testsuite/gfortran.dg/unsigned_2.f90 | 4 +-
gcc/testsuite/gfortran.dg/unsigned_4.f90 | 4 +-
gcc/testsuite/gfortran.dg/unsigned_5.f90 | 12 +--
gcc/testsuite/gfortran.dg/unsigned_6.f90 | 19 ++++
14 files changed, 312 insertions(+), 16 deletions(-)
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 73e0610689e6..b270ae8741ff 100644
--- 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 e796d4dac293..95db799167ae 100644
--- 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 25ae21a8e5f8..b07de09b6671 100644
--- 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 b241e2834b9b..e3567cd0d18f 100644
--- 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 65ca14af6765..86f5ce9f1e32 100644
--- 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 bfd0ac4c7f01..fcb2733ddec8 100644
--- 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 c63a4a8d38cd..845c99f18ddf 100644
--- 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 8d622702b4ad..0f4f8f506492 100644
--- 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 180d0d7a88c6..2acfc8670791 100644
--- 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 ed1a6eed937e..cf5c767456c8 100644
--- 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 e55e0f51a6df..8daf0d518b8e 100644
--- 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 495523d919d3..46b08a3e81f6 100644
--- 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 5fbd1b4150b9..b8b956ecdf67 100644
--- 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
index 000000000000..5caffeee7ab1
--- /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
