OK.  Thanks for the patch.

-- 
steve

On Sat, Sep 28, 2024 at 09:33:20AM +0200, Thomas Koenig wrote:
> 
> this patch, consisting almost entirely of the test cases, implements
> CSHIFT and EOSHIFT for unsigneds.
> 
> OK for trunk?
> 
>     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.

> From d73e3fff882de4ea8e7412e47a3f257f0ca12cd7 Mon Sep 17 00:00:00 2001
> From: Thomas Koenig <tkoe...@gcc.gnu.org>
> Date: Thu, 26 Sep 2024 21:46:55 +0200
> Subject: [PATCH] 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.
> ---
>  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(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/unsigned_31.f90
>  create mode 100644 gcc/testsuite/gfortran.dg/unsigned_32.f90
> 
> diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
> index 1851cfb8d4a..1da269f5b72 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 a5ebadff3bb..b42d0095e57 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 bd2f6485c95..2f6c3c39dad 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 00000000000..2a7c08ddba8
> --- /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 00000000000..7d41988b042
> --- /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
> -- 
> 2.34.1
> 


-- 
Steve

Reply via email to