https://gcc.gnu.org/g:1c928004cf0bc2131b6199905d11133d23a7cef2
commit r15-3942-g1c928004cf0bc2131b6199905d11133d23a7cef2
Author: Thomas Koenig <tkoe...@gcc.gnu.org>
Date: Sat Sep 28 22:28:59 2024 +0200
Implement CSHIFT and EOSHIFT for unsigned.
gcc/fortran/ChangeLog:
* check.cc (gfc_check_eoshift): Handle BT_UNSIGNED.
* simplify.cc (gfc_simplify_eoshift): Likewise.
* gfortran.texi: Document CSHIFT and EOSHIFT for UNSIGNED.
gcc/testsuite/ChangeLog:
* gfortran.dg/unsigned_31.f90: New test.
* gfortran.dg/unsigned_32.f90: New test.
Diff:
---
gcc/fortran/check.cc | 6 ++++++
gcc/fortran/gfortran.texi | 3 ++-
gcc/fortran/simplify.cc | 4 ++++
gcc/testsuite/gfortran.dg/unsigned_31.f90 | 27 +++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/unsigned_32.f90 | 27 +++++++++++++++++++++++++++
5 files changed, 66 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 1851cfb8d4ad..1da269f5b725 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -3073,6 +3073,12 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift,
gfc_expr *boundary,
case BT_CHARACTER:
break;
+ case BT_UNSIGNED:
+ if (flag_unsigned)
+ break;
+
+ gcc_fallthrough();
+
default:
gfc_error ("Missing %qs argument to %qs intrinsic at %L for %qs "
"of type %qs", gfc_current_intrinsic_arg[2]->name,
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index a5ebadff3bb8..b42d0095e571 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2790,7 +2790,8 @@ 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}.
+@item @code{RANDOM_NUMBER}
+@item @code{CSHIFT} and @code{EOSHIFT}.
@end itemize
This list will grow in the near future.
@c ---------------------------------------------------------------------
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index bd2f6485c95e..2f6c3c39dad8 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -2630,6 +2630,10 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift,
gfc_expr *boundary,
bnd = gfc_get_int_expr (array->ts.kind, NULL, 0);
break;
+ case BT_UNSIGNED:
+ bnd = gfc_get_unsigned_expr (array->ts.kind, NULL, 0);
+ break;
+
case BT_LOGICAL:
bnd = gfc_get_logical_expr (array->ts.kind, NULL, 0);
break;
diff --git a/gcc/testsuite/gfortran.dg/unsigned_31.f90
b/gcc/testsuite/gfortran.dg/unsigned_31.f90
new file mode 100644
index 000000000000..2a7c08ddba86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_31.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+program memain
+ call test1
+ call test2
+contains
+ subroutine test1
+ unsigned, dimension(3) :: v
+ unsigned, dimension(3,3) :: w, x
+ integer, dimension(3) :: shft
+ v = [1u, 2u, 3u]
+ if (any(eoshift(v,1) /= [2u,3u,0u])) error stop 1
+ w = reshape([1u,2u,3u,4u,5u,6u,7u,8u,9u],[3,3])
+ x = eoshift(w, shift=[1,-2,1], boundary=10u, dim=1)
+ if (any(x /= reshape([2u,3u,10u,10u,10u,4u,8u,9u,10u],[3,3]))) error stop 2
+ shft = [2,-1,-2]
+ x = eoshift(w,shift=shft,boundary=20u,dim=2)
+ if (any(x /= reshape([7u,20u,20u,20u,2u,20u,20u,5u,3u],[3,3]))) error stop
3
+ end subroutine test1
+ subroutine test2
+ unsigned, dimension(3), parameter :: v = eoshift([1u,2u,3u],1)
+ unsigned, dimension(3,3), parameter :: w =
reshape([1u,2u,3u,4u,5u,6u,7u,8u,9u],[3,3])
+ unsigned, dimension(3,3), parameter :: x = eoshift(w,shift=[1,-2,1],
boundary=10u, dim=1)
+ if (any(v /= [2u,3u,0u])) error stop 11
+ if (any(x /= reshape([2u,3u,10u,10u,10u,4u,8u,9u,10u],[3,3]))) error stop 2
+ end subroutine test2
+end program memain
diff --git a/gcc/testsuite/gfortran.dg/unsigned_32.f90
b/gcc/testsuite/gfortran.dg/unsigned_32.f90
new file mode 100644
index 000000000000..7d41988b0420
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_32.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+program memain
+ call test1
+ call test2
+contains
+ subroutine test1
+ unsigned, dimension(3) :: v
+ unsigned, dimension(3,3) :: w, x
+ integer, dimension(3) :: shft
+ v = [1u, 2u, 3u]
+ if (any(cshift(v,1) /= [2u,3u,1u])) error stop 1
+ w = reshape([1u,2u,3u,4u,5u,6u,7u,8u,9u],[3,3])
+ x = cshift(w, shift=[1,-2,1], dim=1)
+ if (any(x /= reshape([2u,3u,1u,5u,6u,4u,8u,9u,7u],[3,3]))) error stop 2
+ shft = [2,-1,-2]
+ x = cshift(w,shift=shft,dim=2)
+ if (any(x /= reshape([7u,8u,6u,1u,2u,9u,4u,5u,3u],[3,3]))) error stop 3
+ end subroutine test1
+ subroutine test2
+ unsigned, dimension(3), parameter :: v = cshift([1u,2u,3u],1)
+ unsigned, dimension(3,3), parameter :: w =
reshape([1u,2u,3u,4u,5u,6u,7u,8u,9u],[3,3])
+ unsigned, dimension(3,3), parameter :: x = cshift(w,shift=[1,-2,1], dim=1)
+ if (any(v /= [2u,3u,1u])) error stop 11
+ if (any(x /= reshape([2u,3u,1u,5u,6u,4u,8u,9u,7u],[3,3]))) error stop 12
+ end subroutine test2
+end program memain
