[Fortran] FINDLOC for unsigned

Message ID 8af0ddf4-fbd2-4978-87b9-e35887434dcf@netcologne.de
State New
Headers
Series [Fortran] FINDLOC for unsigned |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-arm warning Patch is already merged
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 warning Patch is already merged

Commit Message

Thomas Koenig Sept. 28, 2024, 6:32 p.m. UTC
  Hello world,

here's another small patch for FINDLOC for unsigned.

OK for trunk?

Best regards

	Thomas

Implement FINDLOC for UNSIGNED.

gcc/fortran/ChangeLog:

	* check.cc (intrinsic_type_check): Handle unsigned.
	(gfc_check_findloc): Likewise.
	* gfortran.texi: Include FINDLOC in unsigned documentation.
	* iresolve.cc (gfc_resolve_findloc): Use INTEGER version
	for UNSIGNED.

gcc/testsuite/ChangeLog:

	* gfortran.dg/unsigned_33.f90: New test.
  

Comments

Steve Kargl Sept. 28, 2024, 7:14 p.m. UTC | #1
On Sat, Sep 28, 2024 at 08:32:00PM +0200, Thomas Koenig wrote:
> Hello world,
> 
> here's another small patch for FINDLOC for unsigned.
> 
> OK for trunk?
> 

OK.  Other than UNSIGNED being a new experimental feature,
this patch almost qualifies as "Obvious".
  

Patch

From 864071a00f886ae2115d6dfa5d286c84e67360f6 Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Sat, 28 Sep 2024 19:10:08 +0200
Subject: [PATCH] Implement FINDLOC for UNSIGNED.

gcc/fortran/ChangeLog:

	* check.cc (intrinsic_type_check): Handle unsigned.
	(gfc_check_findloc): Likewise.
	* gfortran.texi: Include FINDLOC in unsigned documentation.
	* iresolve.cc (gfc_resolve_findloc): Use INTEGER version
	for UNSIGNED.

gcc/testsuite/ChangeLog:

	* gfortran.dg/unsigned_33.f90: New test.
---
 gcc/fortran/check.cc                      |  5 +-
 gcc/fortran/gfortran.texi                 |  3 +-
 gcc/fortran/iresolve.cc                   |  9 ++-
 gcc/testsuite/gfortran.dg/unsigned_33.f90 | 76 +++++++++++++++++++++++
 4 files changed, 90 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/unsigned_33.f90

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 1da269f5b72..dd79a49a0c9 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -643,7 +643,7 @@  intrinsic_type_check (gfc_expr *e, int n)
 {
   if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL
       && e->ts.type != BT_COMPLEX && e->ts.type != BT_CHARACTER
-      && e->ts.type != BT_LOGICAL)
+      && e->ts.type != BT_LOGICAL && e->ts.type != BT_UNSIGNED)
     {
       gfc_error ("%qs argument of %qs intrinsic at %L must be of intrinsic type",
 		 gfc_current_intrinsic_arg[n]->name,
@@ -4267,6 +4267,9 @@  gfc_check_findloc (gfc_actual_arglist *ap)
   if ((a1 && !v1) || (!a1 && v1))
     goto incompat;
 
+  if (flag_unsigned && gfc_invalid_unsigned_ops (a,v))
+    goto incompat;
+
   /* Check the kind of the characters argument match.  */
   if (a1 && v1 && a->ts.kind != v->ts.kind)
     goto incompat;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index b42d0095e57..7aa16428867 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2791,7 +2791,8 @@  As of now, the following intrinsics take unsigned arguments:
 @item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}
 @item @code{IANY}, @code{IALL} and @code{IPARITY}
 @item @code{RANDOM_NUMBER}
-@item @code{CSHIFT} and @code{EOSHIFT}.
+@item @code{CSHIFT} and @code{EOSHIFT}
+@item @code{FINDLOC}.
 @end itemize
 This list will grow in the near future.
 @c ---------------------------------------------------------------------
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 5a1e0a6ed1d..9fb22128492 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -1819,6 +1819,7 @@  gfc_resolve_findloc (gfc_expr *f, gfc_expr *array, gfc_expr *value,
   int i, j, idim;
   int fkind;
   int d_num;
+  bt type;
 
   /* See at the end of the function for why this is necessary.  */
 
@@ -1897,9 +1898,15 @@  gfc_resolve_findloc (gfc_expr *f, gfc_expr *array, gfc_expr *value,
       gfc_convert_type_warn (back, &ts, 2, 0);
     }
 
+  /* Use the INTEGER library function for UNSIGNED.  */
+  if (array->ts.type != BT_UNSIGNED)
+    type = array->ts.type;
+  else
+    type = BT_INTEGER;
+
   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%c%d"), name, d_num,
-		      gfc_type_letter (array->ts.type, true),
+		      gfc_type_letter (type, true),
 		      gfc_type_abi_kind (&array->ts));
 
   /* We only have a single library function, so we need to convert
diff --git a/gcc/testsuite/gfortran.dg/unsigned_33.f90 b/gcc/testsuite/gfortran.dg/unsigned_33.f90
new file mode 100644
index 00000000000..7ff11e6c9bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_33.f90
@@ -0,0 +1,76 @@ 
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Check compile-time simplification of FINDLOC
+! Mostly lifted from findloc_5.f90.
+program memain
+  implicit none
+  call test1
+  call test2
+contains
+  subroutine test1
+    unsigned, dimension(4) :: a1
+    integer :: i1, i2, i3, i4
+    unsigned, dimension(2,2) :: a, b
+    integer, dimension(2) :: t8, t9, t10
+    unsigned, dimension(2,3) :: c
+    integer, dimension(3) :: t13
+    integer, dimension(2) :: t14
+
+    a1 = [1u,  2u,  3u,  1u]
+    i1 = findloc(a1, 1u, dim=1)
+    if (i1 /= 1) stop 1
+    i2 = findloc(a1, 2u, dim=1)
+    if (i2 /= 2) stop 2
+    i3 = findloc(a1,3u, dim=1)
+    if (i3 /= 3) stop 3
+    i4 = findloc(a1, 1u, dim=1, back=.true.)
+    if (i4 /= 4) stop 4
+    a = reshape([1u,2u,3u,4u], [2,2])
+    b = reshape([1u,2u,1u,2u], [2,2])
+    t8 = findloc(a,5u)
+    if (any(t8 /= [0,0])) stop 8
+    t9 = findloc(a,5u,back=.true.)
+    if (any(t9 /= [0,0])) stop 9
+    c = reshape([1u,2u,2u,2u,-9u,6u], [2,3])
+    t13 = findloc (c, value=2u, dim=1)
+    if (any(t13 /= [2,1,0])) stop 13
+    t14 = findloc (c, value=2u, dim=2)
+    if (any(t14 /= [2,1])) stop 14
+  end subroutine test1
+  subroutine test2
+    unsigned,  dimension(4),  parameter :: a1 = [1u,  2u,  3u,  1u]
+    integer,  parameter :: i1 = findloc(a1, 1u, dim=1)
+    integer,  parameter :: i2 = findloc(a1, 2u, dim=1)
+    integer,  parameter :: i3 = findloc(a1, 3u, dim=1)
+    integer,  parameter :: i4 = findloc(a1, 1u, dim=1, back=.true.)
+    integer,  parameter :: i0 = findloc(a1, -1u, dim=1)
+    logical,  dimension(4),  parameter :: msk = [.false., .true., .true., .true.]
+    integer,  parameter :: i4a = findloc(a1, 1u, dim=1, mask=msk)
+    integer,  parameter :: i4b = findloc(a1, 1u, dim=1, mask=msk, back=.true.)
+    unsigned, dimension(2,2), parameter :: a = reshape([1u,2u,3u,4u], [2,2]), &
+       b =  reshape([1u,2u,1u,2u], [2,2])
+    integer, parameter, dimension(2) :: t8 = findloc(a, 5u), t9 = findloc(a, 5u, back=.true.)
+    integer, parameter, dimension(2) :: t10= findloc(a, 2u), t11= findloc(a, 2u, back=.true.)
+    logical, dimension(2,2), parameter :: lo = reshape([.true., .false., .true., .true. ], [2,2])
+    integer, parameter, dimension(2) :: t12 = findloc(b,2u, mask=lo)
+
+    unsigned, dimension(2,3), parameter :: c = reshape([1u,2u,2u,2u,-9u,6u], [2,3])
+    integer, parameter, dimension(3) :: t13 = findloc(c, value=2u, dim=1)
+    integer, parameter, dimension(2) :: t14 = findloc(c, value=2u, dim=2)
+
+    if (i1 /= 1) stop 1
+    if (i2 /= 2) stop 2
+    if (i3 /= 3) stop 3
+    if (i4 /= 4) stop 4
+    if (i0 /= 0) stop 5
+    if (i4a /= 4) stop 6
+    if (i4b /= 4) stop 7
+    if (any(t8 /= [0,0])) stop 8
+    if (any(t9 /= [0,0])) stop 9
+    if (any(t10 /= [2,1])) stop 10
+    if (any(t11 /= [2,1])) stop 11
+    if (any(t12 /= [2,2])) stop 12
+    if (any(t13 /= [2,1,0])) stop 13
+    if (any(t14 /= [2,1])) stop 14
+  end subroutine test2
+end program memain
-- 
2.34.1