aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorThomas Koenig <tkoenig@gcc.gnu.org>2024-09-24 22:57:42 +0200
committerThomas Koenig <tkoenig@gcc.gnu.org>2024-09-24 22:57:42 +0200
commit291e20e86090e5940e2bd862ec83c7d5e0715dd5 (patch)
tree0b970817fd91a79f75b59b6befede665a69b910e /gcc
parentfbeb1a965d85492e2f6f3adf913b90d005151b00 (diff)
downloadgcc-291e20e86090e5940e2bd862ec83c7d5e0715dd5.zip
gcc-291e20e86090e5940e2bd862ec83c7d5e0715dd5.tar.gz
gcc-291e20e86090e5940e2bd862ec83c7d5e0715dd5.tar.bz2
Add random numbers and fix some bugs.
This patch adds random number support for UNSIGNED, plus fixes two bugs, with array I/O where the type used to be set to BT_INTEGER, and for division with the divisor being a constant. gcc/fortran/ChangeLog: * check.cc (gfc_check_random_number): Adjust for unsigned. * iresolve.cc (gfc_resolve_random_number): Handle unsigned. * trans-expr.cc (gfc_conv_expr_op): Handle BT_UNSIGNED for divide. * trans-types.cc (gfc_get_dtype_rank_type): Handle BT_UNSIGNED. * gfortran.texi: Add RANDOM_NUMBER for UNSIGNED. libgfortran/ChangeLog: * gfortran.map: Add _gfortran_random_m1, _gfortran_random_m2, _gfortran_random_m4, _gfortran_random_m8 and _gfortran_random_m16. * intrinsics/random.c (random_m1): New function. (random_m2): New function. (random_m4): New function. (random_m8): New function. (random_m16): New function. (arandom_m1): New function. (arandom_m2): New function. (arandom_m4): New function. (arandom_m8): New funciton. (arandom_m16): New function. gcc/testsuite/ChangeLog: * gfortran.dg/unsigned_30.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/check.cc10
-rw-r--r--gcc/fortran/gfortran.texi1
-rw-r--r--gcc/fortran/iresolve.cc6
-rw-r--r--gcc/fortran/trans-expr.cc4
-rw-r--r--gcc/fortran/trans-types.cc7
-rw-r--r--gcc/testsuite/gfortran.dg/unsigned_30.f9063
6 files changed, 84 insertions, 7 deletions
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 533c9d7..1851cfb 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -7007,8 +7007,14 @@ gfc_check_random_init (gfc_expr *repeatable, gfc_expr *image_distinct)
bool
gfc_check_random_number (gfc_expr *harvest)
{
- if (!type_check (harvest, 0, BT_REAL))
- return false;
+ if (flag_unsigned)
+ {
+ if (!type_check2 (harvest, 0, BT_REAL, BT_UNSIGNED))
+ return false;
+ }
+ else
+ if (!type_check (harvest, 0, BT_REAL))
+ return false;
if (!variable_check (harvest, 0, false))
return false;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 3eb8039..a5ebadff 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2790,6 +2790,7 @@ As of now, the following intrinsics take unsigned arguments:
@item @code{TRANSFER}
@item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}
@item @code{IANY}, @code{IALL} and @code{IPARITY}
+@item @code{RANDOM_NUMBER}.
@end itemize
This list will grow in the near future.
@c ---------------------------------------------------------------------
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index b281ab7..5a1e0a6 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3452,12 +3452,14 @@ gfc_resolve_random_number (gfc_code *c)
{
const char *name;
int kind;
+ char type;
kind = gfc_type_abi_kind (&c->ext.actual->expr->ts);
+ type = gfc_type_letter (c->ext.actual->expr->ts.type);
if (c->ext.actual->expr->rank == 0)
- name = gfc_get_string (PREFIX ("random_r%d"), kind);
+ name = gfc_get_string (PREFIX ("random_%c%d"), type, kind);
else
- name = gfc_get_string (PREFIX ("arandom_r%d"), kind);
+ name = gfc_get_string (PREFIX ("arandom_%c%d"), type, kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d0c7dfe..e4c491a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -3973,9 +3973,9 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
case INTRINSIC_DIVIDE:
/* If expr is a real or complex expr, use an RDIV_EXPR. If op1 is
- an integer, we must round towards zero, so we use a
+ an integer or unsigned, we must round towards zero, so we use a
TRUNC_DIV_EXPR. */
- if (expr->ts.type == BT_INTEGER)
+ if (expr->ts.type == BT_INTEGER || expr->ts.type == BT_UNSIGNED)
code = TRUNC_DIV_EXPR;
else
code = RDIV_EXPR;
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 96ef8b4..05e64b3 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1651,7 +1651,12 @@ gfc_get_dtype_rank_type (int rank, tree etype)
&& TYPE_STRING_FLAG (ptype))
n = BT_CHARACTER;
else
- n = BT_INTEGER;
+ {
+ if (TYPE_UNSIGNED (etype))
+ n = BT_UNSIGNED;
+ else
+ n = BT_INTEGER;
+ }
break;
case BOOLEAN_TYPE:
diff --git a/gcc/testsuite/gfortran.dg/unsigned_30.f90 b/gcc/testsuite/gfortran.dg/unsigned_30.f90
new file mode 100644
index 0000000..b0a1555
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_30.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+
+! The leading bytes of the unsigned sequences should be the same for
+! kinds 1 to 8. This also tests array I/O for unsigneds.
+
+program memain
+ implicit none
+ integer, dimension(:), allocatable :: seed
+ integer :: n
+ call random_seed (size=n)
+ allocate(seed(n))
+ call test1
+ call test2
+contains
+ subroutine test1
+ unsigned(1) :: u1
+ unsigned(2) :: u2
+ unsigned(4) :: u4
+ unsigned(8) :: u8
+ character (len=16) :: line1, line2, line4, line8
+ integer :: i, n
+ do i=1,10
+ call random_seed(get=seed)
+ call random_number(u1)
+ write (line1,'(Z2.2)') u1
+ call random_seed(put=seed)
+ call random_number(u2)
+ write (line2,'(Z4.4)') u2
+ call random_seed(put=seed)
+ call random_number(u4)
+ write (line4,'(Z8.8)') u4
+ call random_seed(put=seed)
+ call random_number(u8)
+ write (line8,'(Z16.16)') u8
+ if (line8(1:8) /= line4 (1:8)) error stop 1
+ if (line4(1:4) /= line2 (1:4)) error stop 2
+ if (line2(1:2) /= line1 (1:2)) error stop 3
+ end do
+ end subroutine test1
+ subroutine test2
+ unsigned(1), dimension(2,2) :: v1
+ unsigned(2), dimension(2,2) :: v2
+ unsigned(4), dimension(2,2) :: v4
+ unsigned(8), dimension(2,2) :: v8
+ character(len=16), dimension(4) :: c1, c2, c4, c8
+ call random_seed(put=seed)
+ call random_number (v1)
+ write (c1,'(Z2.2)') v1
+ call random_seed(put=seed)
+ call random_number (v2)
+ write (c2,'(Z4.4)') v2
+ call random_seed(put=seed)
+ call random_number (v4)
+ write (c4,'(Z8.8)') v4
+ call random_seed(put=seed)
+ call random_number (v8)
+ write (c8,'(Z16.16)') v8
+ if (any(c8(:)(1:8) /= c4(:)(1:8))) error stop 10
+ if (any(c4(:)(1:4) /= c2(:)(1:4))) error stop 11
+ if (any(c2(:)(1:2) /= c1(:)(1:2))) error stop 12
+ end subroutine test2
+end program memain