diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2024-09-24 22:57:42 +0200 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2024-09-24 22:57:42 +0200 |
commit | 291e20e86090e5940e2bd862ec83c7d5e0715dd5 (patch) | |
tree | 0b970817fd91a79f75b59b6befede665a69b910e /gcc | |
parent | fbeb1a965d85492e2f6f3adf913b90d005151b00 (diff) | |
download | gcc-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.cc | 10 | ||||
-rw-r--r-- | gcc/fortran/gfortran.texi | 1 | ||||
-rw-r--r-- | gcc/fortran/iresolve.cc | 6 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.cc | 4 | ||||
-rw-r--r-- | gcc/fortran/trans-types.cc | 7 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/unsigned_30.f90 | 63 |
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 |