[gcc/devel/omp/gcc-11] OpenACC: fix privatization of by-reference arrays

[gcc/devel/omp/gcc-11] OpenACC: fix privatization of by-reference arrays

[Kwok Yeung]

https://gcc.gnu.org/g:c00852695b0c11834252bb6f2e551a54a2922efe

commit c00852695b0c11834252bb6f2e551a54a2922efe
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Wed Jun 3 15:35:12 2020 +0200

    OpenACC: fix privatization of by-reference arrays
    
    Replacing of a by-reference variable in a private clause by a local variable
    makes sense; however, for arrays, the size is not directly known by the type.
    This causes an ICE via create_tmp_var which indirectly invokes
    force_constant_size in this case - but the latter only handled Ada.
    
    gcc/ChangeLog:
    
            * gimplify.c (localize_reductions): Do not create local
            variable for privatized arrays.
    
    libgomp/ChangeLog:
    
            * testsuite/libgomp.oacc-fortran/privatized-ref-2.f90: New test.

Diff:
---
 gcc/gimplify.c                                     |   3 +-
 .../libgomp.oacc-fortran/privatized-ref-2.f90      | 101 +++++++++++++++++++++
 2 files changed, 103 insertions(+), 1 deletion(-)

diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 0ef1583d98e..3efa48e8ec9 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -11691,8 +11691,9 @@ localize_reductions (tree clauses, tree body)
 
 	if (!lang_hooks.decls.omp_privatize_by_reference (var))
 	  continue;
-
 	type = TREE_TYPE (TREE_TYPE (var));
+	if (TREE_CODE (type) == ARRAY_TYPE)
+	  continue;
 	new_var = create_tmp_var (type, IDENTIFIER_POINTER (DECL_NAME (var)));
 
 	pr.ref_var = var;
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-2.f90
new file mode 100644
index 00000000000..ca8fbe8cb76
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-2.f90
@@ -0,0 +1,101 @@
+! { dg-do run }
+
+program main
+  implicit none (type, external)
+  integer :: j
+  integer, allocatable :: A(:)
+  character(len=:), allocatable :: my_str
+  character(len=15), allocatable :: my_str15
+
+  A = [(3*j, j=1, 10)]
+  call foo (A, size(A))
+  call bar (A)
+  my_str = "1234567890"
+  call foo_str(my_str)
+  call bar_str(my_str)
+  my_str15 = "123456789012345"
+  call foobar (my_str15)
+  deallocate (A, my_str, my_str15)
+contains
+  subroutine foo (array, nn)
+    integer :: i, nn
+    integer :: array(nn)
+
+    !$acc parallel copyout(array)
+    array = [(-i, i = 1, nn)]
+    !$acc loop gang private(array)
+    do i = 1, 10
+      array(i) = i
+    end do
+    if (any (array /= [(-i, i = 1, nn)])) error stop 1
+    !$acc end parallel
+  end subroutine foo
+  subroutine bar (array)
+    integer :: i
+    integer :: array(:)
+
+    !$acc parallel copyout(array)
+    array = [(-2*i, i = 1, size(array))]
+    !$acc loop gang private(array)
+    do i = 1, 10
+      array(i) = 9*i
+    end do
+    if (any (array /= [(-2*i, i = 1, 10)])) error stop 2
+    !$acc end parallel
+  end subroutine bar
+  subroutine foo_str(str)
+    integer :: i
+    character(len=*) :: str
+
+    !$acc parallel copyout(str)
+    str = "abcdefghij"
+    !$acc loop gang private(str)
+    do i = 1, 10
+      str(i:i) = achar(ichar('A') + i)
+    end do
+    if (str /= "abcdefghij") error stop 3
+    !$acc end parallel
+  end
+  subroutine bar_str(str)
+    integer :: i
+    character(len=:), allocatable :: str
+
+! ***************************************
+! FIXME: Fails due to PR middle-end/95499
+! ***************************************
+    !!$acc parallel copyout(str)
+    str = "abcdefghij"
+    !!$acc loop gang private(str)
+    !do i = 1, 10
+    !  str(i:i) = achar(ichar('A') + i)
+    !end do
+    if (str /= "abcdefghij") error stop 5
+    !!$acc end parallel
+  end
+  subroutine foobar (scalar)
+    integer :: i
+    character(len=15), optional :: scalar
+
+    !$acc parallel copyout(scalar)
+    scalar = "abcdefghi-12345"
+    !$acc loop gang private(scalar)
+    do i = 1, 15
+      scalar(i:i) = achar(ichar('A') + i)
+    end do
+    !$acc end parallel
+    if (scalar /= "abcdefghi-12345") error stop 6
+  end subroutine foobar
+  subroutine foobar15 (scalar)
+    integer :: i
+    character(len=15), optional, allocatable :: scalar
+
+    !$acc parallel copyout(scalar)
+    scalar = "abcdefghi-12345"
+    !$acc loop gang private(scalar)
+    do i = 1, 15
+      scalar(i:i) = achar(ichar('A') + i)
+    end do
+    !$acc end parallel
+    if (scalar /= "abcdefghi-12345") error stop 1
+  end subroutine foobar15
+end