aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorThomas Koenig <tkoenig@gcc.gnu.org>2024-09-29 16:52:51 +0200
committerThomas Koenig <tkoenig@gcc.gnu.org>2024-10-01 18:42:37 +0200
commit9dd9a06940a37e82d13ccd2be0c4ef68bca29750 (patch)
tree3622002cb007c51cd0038b7d8c9c03c9887a73b0 /gcc
parentbe2f7a1871ae7a256f34393eeba583ff575cb7e8 (diff)
downloadgcc-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.cc44
-rw-r--r--gcc/fortran/gfortran.texi3
-rw-r--r--gcc/fortran/trans-intrinsic.cc14
-rw-r--r--gcc/testsuite/gfortran.dg/unsigned_34.f9053
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