diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2024-09-29 16:52:51 +0200 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2024-10-01 18:42:37 +0200 |
commit | 9dd9a06940a37e82d13ccd2be0c4ef68bca29750 (patch) | |
tree | 3622002cb007c51cd0038b7d8c9c03c9887a73b0 /gcc | |
parent | be2f7a1871ae7a256f34393eeba583ff575cb7e8 (diff) | |
download | gcc-9dd9a06940a37e82d13ccd2be0c4ef68bca29750.zip gcc-9dd9a06940a37e82d13ccd2be0c4ef68bca29750.tar.gz gcc-9dd9a06940a37e82d13ccd2be0c4ef68bca29750.tar.bz2 |
Implement MAXVAL and MINVAL for UNSIGNED.
gcc/fortran/ChangeLog:
* check.cc (int_or_real_or_char_or_unsigned_check_f2003): New function.
(gfc_check_minval_maxval): Use it.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxval): Handle
initial values for UNSIGNED.
* gfortran.texi: Document MINVAL and MAXVAL for unsigned.
libgfortran/ChangeLog:
* Makefile.am: Add minval and maxval files.
* Makefile.in: Regenerated.
* gfortran.map: Add new functions.
* generated/maxval_m1.c: New file.
* generated/maxval_m16.c: New file.
* generated/maxval_m2.c: New file.
* generated/maxval_m4.c: New file.
* generated/maxval_m8.c: New file.
* generated/minval_m1.c: New file.
* generated/minval_m16.c: New file.
* generated/minval_m2.c: New file.
* generated/minval_m4.c: New file.
* generated/minval_m8.c: New file.
gcc/testsuite/ChangeLog:
* gfortran.dg/unsigned_34.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/check.cc | 44 | ||||
-rw-r--r-- | gcc/fortran/gfortran.texi | 3 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.cc | 14 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/unsigned_34.f90 | 53 |
4 files changed, 109 insertions, 5 deletions
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index dd79a49..9c0b72f 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -637,6 +637,39 @@ int_or_real_or_char_check_f2003 (gfc_expr *e, int n) return true; } +/* Check that an expression is integer or real or unsigned; allow character for + F2003 or later. */ + +static bool +int_or_real_or_char_or_unsigned_check_f2003 (gfc_expr *e, int n) +{ + if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL + && e->ts.type != BT_UNSIGNED) + { + if (e->ts.type == BT_CHARACTER) + return gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Character for " + "%qs argument of %qs intrinsic at %L", + gfc_current_intrinsic_arg[n]->name, + gfc_current_intrinsic, &e->where); + else + { + if (gfc_option.allow_std & GFC_STD_F2003) + gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER " + "or REAL or CHARACTER or UNSIGNED", + gfc_current_intrinsic_arg[n]->name, + gfc_current_intrinsic, &e->where); + else + gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER " + "or REAL or UNSIGNED", + gfc_current_intrinsic_arg[n]->name, + gfc_current_intrinsic, &e->where); + } + return false; + } + + return true; +} + /* Check that an expression is an intrinsic type. */ static bool intrinsic_type_check (gfc_expr *e, int n) @@ -4389,8 +4422,15 @@ check_reduction (gfc_actual_arglist *ap) bool gfc_check_minval_maxval (gfc_actual_arglist *ap) { - if (!int_or_real_or_char_check_f2003 (ap->expr, 0) - || !array_check (ap->expr, 0)) + if (flag_unsigned) + { + if (!int_or_real_or_char_or_unsigned_check_f2003 (ap->expr, 0)) + return false; + } + else if (!int_or_real_or_char_check_f2003 (ap->expr, 0)) + return false; + + if (!array_check (ap->expr, 0)) return false; return check_reduction (ap); diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 7aa1642..db8c44f 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -2792,7 +2792,8 @@ As of now, the following intrinsics take unsigned arguments: @item @code{IANY}, @code{IALL} and @code{IPARITY} @item @code{RANDOM_NUMBER} @item @code{CSHIFT} and @code{EOSHIFT} -@item @code{FINDLOC}. +@item @code{FINDLOC} +@item @code{MAXVAL} and @code{MINVAL}. @end itemize This list will grow in the near future. @c --------------------------------------------------------------------- diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 5505a21..e065e31 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -6443,6 +6443,15 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) tmp = gfc_conv_mpz_to_tree (gfc_integer_kinds[n].huge, expr->ts.kind); break; + case BT_UNSIGNED: + /* For MAXVAL, the minimum is zero, for MINVAL it is HUGE(). */ + if (op == GT_EXPR) + tmp = build_int_cst (type, 0); + else + tmp = gfc_conv_mpz_unsigned_to_tree (gfc_unsigned_kinds[n].huge, + expr->ts.kind); + break; + default: gcc_unreachable (); } @@ -6450,8 +6459,9 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) /* We start with the most negative possible value for MAXVAL, and the most positive possible value for MINVAL. The most negative possible value is -HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive - possible value is HUGE in both cases. */ - if (op == GT_EXPR) + possible value is HUGE in both cases. BT_UNSIGNED has already been dealt + with above. */ + if (op == GT_EXPR && expr->ts.type != BT_UNSIGNED) { tmp = fold_build1_loc (input_location, NEGATE_EXPR, TREE_TYPE (tmp), tmp); if (huge_cst) diff --git a/gcc/testsuite/gfortran.dg/unsigned_34.f90 b/gcc/testsuite/gfortran.dg/unsigned_34.f90 new file mode 100644 index 0000000..238f11a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unsigned_34.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! { dg-options "-funsigned" } +program memain + implicit none + call test1 + call test2 +contains + subroutine test1 + unsigned, dimension(3) :: v + unsigned :: t1, t2 + unsigned(2), dimension(3,3) :: w + integer, dimension(3,3) :: j + integer :: di + v = [1u, 2u, 4294967286u] + t1 = maxval(v,dim=1) + if (t1 /= 4294967286u) error stop 1 + t2 = minval(v,dim=1) + if (t2 /= 1u) error stop 2 + call check_empty(0) + j = reshape([1,2,3,65534,5,1,65000,2,1],[3,3]) + w = uint(j,2) + if (any(maxval(j,dim=1) /= int(maxval(w,dim=1)))) error stop 5 + di = 2 + if (any(maxval(j,dim=di) /= int(maxval(w,dim=di)))) error stop 6 + end subroutine test1 + subroutine check_empty(n) + integer, intent(in) :: n + unsigned, dimension(n) :: empty + if (minval(empty,dim=1) /= 4294967295u) error stop 3 + if (maxval(empty,dim=1) /= 0u) error stop 4 + end subroutine check_empty + subroutine test2 + integer :: i + unsigned, dimension(3), parameter :: v = [1u, 2u, 4294967286u] + unsigned, parameter :: t1 = maxval(v,dim=1) + unsigned, parameter :: t2 = minval(v,dim=1) + unsigned, parameter, dimension(2:1) :: empty = [(0u,i=2,1)] + unsigned, parameter :: t3 = minval(empty,1) + unsigned, parameter :: t4 = maxval(empty,1) + unsigned(2), parameter, dimension(2:1,2:1) :: e2 = reshape(empty,[0,0]) + integer, parameter, dimension(3,3) :: j = reshape([1,2,3,65534,5,1,65000,2,1],[3,3]) + integer, parameter, dimension(3) :: maxvj = maxval(j,1), minvj=minval(j,2) + unsigned, parameter, dimension(3,3) :: w = uint(j,2) + unsigned(2), parameter, dimension(3) :: maxvw = maxval(w,1), minvw = minval(w,2) + + if (t1 /= 4294967286u) error stop 11 + if (t2 /= 1u) error stop 12 + if (t3 /= 4294967295u) error stop 13 + if (t4 /= 0u) error stop 14 + if (any(maxvj /= int(maxvw))) error stop 15 + if (any(minvj /= int(minvw))) error stop 16 + end subroutine test2 +end program memain |