Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).

[Thomas Schwinge <thomas@codesourcery.com>]

Hi Tobias!

On 2022-01-24T09:45:48+0100, Tobias Burnus <tobias@codesourcery.com> wrote:
> On 21.01.22 18:43, Tobias Burnus wrote:
>> On 21.01.22 18:15, Thomas Schwinge wrote:
>>>         11 |     integer(c_int) function is_64bit_aligned (a) bind(C)
>>>      Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C)
>>> procedure ‘is_64bit_aligned’ but may not be C interoperable
>>> [-Wc-binding-type]
>>>
>>> Is that something to worry about?
> I have attached a patch (not commited), which silences the three kind of
> warnings and fixes the interface issue.
> TODO: commit it.

Still "TODO: commit it" ;-) -- and while I haven't reviewed the changes
in detail, I did spot one item that should be addressed, I suppose:

> --- a/libgomp/testsuite/libgomp.fortran/allocate-1.c
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c
> @@ -1,7 +1,7 @@
>  #include <stdint.h>
>
>  int
> -is_64bit_aligned_ (uintptr_t a)
> +is_64bit_aligned (uintptr_t a)
>  {
>    return ( (a & 0x3f) == 0);
>  }

> --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> @@ -5,30 +5,30 @@
>  module m
>    use omp_lib
>    use iso_c_binding
> -  implicit none
> +  implicit none (type, external)
>
>    interface
>      integer(c_int) function is_64bit_aligned (a) bind(C)
>        import :: c_int
> -      integer  :: a
> +      type(*)  :: a
>      end
>    end interface
> -end module m
>
> -subroutine foo (x, p, q, px, h, fl)
> +contains
> +
> +subroutine foo (x, p, q, h, fl)
>    use omp_lib
>    use iso_c_binding
>    integer  :: x
>    integer, dimension(4) :: p
>    integer, dimension(4) :: q
> -  integer  :: px
>    integer (kind=omp_allocator_handle_kind) :: h
>    integer  :: fl
>
>    integer  :: y
>    integer  :: r, i, i1, i2, i3, i4, i5
>    integer  :: l, l3, l4, l5, l6
> -  integer  :: n, n1, n2, n3, n4
> +  integer  :: n, n2, n3, n4
>    integer  :: j2, j3, j4
>    integer, dimension(4) :: l2
>    integer, dimension(4) :: r2
> @@ -118,6 +118,7 @@ subroutine foo (x, p, q, px, h, fl)
>    end if
>    !$omp end parallel
>    !$omp end teams
> +stop
>
>    !$omp parallel do private (y) firstprivate (x)  reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l)  linear (n: 16)
>    do i = 0, 63

That early 'stop' should probably be backed out?  ;-)


Grüße
 Thomas


> @@ -153,77 +154,77 @@ subroutine foo (x, p, q, px, h, fl)
>             ((is_64bit_aligned(l2(1)) == 0) .or. &
>              (is_64bit_aligned(l3) == 0) .or. &
>              (is_64bit_aligned(i1) == 0))) then
> -     stop 10
> +        stop 10
>        end if
>      end do
>
>      !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
>      do i2 = 3, 4
>        do j2 = 17, 22, 2
> -     n2 = n2 + 17
> -     l4 = i2 * 31 + j2
> -     if ( (and(fl, 1) /= 0) .and.          &
> -       ((is_64bit_aligned(l4) == 0) .or. &
> -       (is_64bit_aligned(n2) == 0) .or. &
> -       (is_64bit_aligned(i2) == 0) .or. &
> -       (is_64bit_aligned(j2) == 0))) then
> -       stop 11
> -     end if
> +        n2 = n2 + 17
> +        l4 = i2 * 31 + j2
> +        if ( (and(fl, 1) /= 0) .and.          &
> +             ((is_64bit_aligned(l4) == 0) .or. &
> +              (is_64bit_aligned(n2) == 0) .or. &
> +              (is_64bit_aligned(i2) == 0) .or. &
> +              (is_64bit_aligned(j2) == 0))) then
> +          stop 11
> +        end if
>        end do
>      end do
>
>      !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
>      do i3 = 3, 4
>        do j3 = 17, 22, 2
> -       n3 = n3 + 17
> -       l5 = i3 * 31 + j3
> -       if ( (and(fl, 2) /= 0) .and.      &
> -       ((is_64bit_aligned(l5) == 0) .or. &
> -       (is_64bit_aligned(n3) == 0) .or. &
> -       (is_64bit_aligned(i3) == 0) .or. &
> -       (is_64bit_aligned(j3) == 0))) then
> -       stop 12
> -     end if
> +          n3 = n3 + 17
> +          l5 = i3 * 31 + j3
> +          if ( (and(fl, 2) /= 0) .and.      &
> +             ((is_64bit_aligned(l5) == 0) .or. &
> +              (is_64bit_aligned(n3) == 0) .or. &
> +              (is_64bit_aligned(i3) == 0) .or. &
> +              (is_64bit_aligned(j3) == 0))) then
> +          stop 12
> +        end if
>        end do
>      end do
>
>      !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
>      do i4 = 3, 4
>        do j4 = 17, 22,2
> -       n4 = n4 + 17;
> -       l6 = i4 * 31 + j4;
> -     if ( (and(fl, 1) /= 0) .and.          &
> -       ((is_64bit_aligned(l6) == 0) .or. &
> -       (is_64bit_aligned(n4) == 0) .or. &
> -       (is_64bit_aligned(i4) == 0) .or. &
> -       (is_64bit_aligned(j4) == 0))) then
> -       stop 13
> -     end if
> +          n4 = n4 + 17;
> +          l6 = i4 * 31 + j4;
> +        if ( (and(fl, 1) /= 0) .and.          &
> +            ((is_64bit_aligned(l6) == 0) .or. &
> +             (is_64bit_aligned(n4) == 0) .or. &
> +             (is_64bit_aligned(i4) == 0) .or. &
> +             (is_64bit_aligned(j4) == 0))) then
> +          stop 13
> +        end if
>        end do
>      end do
>
>      !$omp do lastprivate (i5) allocate (i5)
>      do i5 = 1, 17, 3
>        if ( (and(fl, 2) /= 0) .and.          &
> -        (is_64bit_aligned(i5) == 0)) then
> -     stop 14
> +           (is_64bit_aligned(i5) == 0)) then
> +        stop 14
>        end if
>      end do
>
>      !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
>      do i = 0, 31
> -     p(3) = p(3) +  i;
> -     p(4) = p(4) + (2 * i)
> -     q(1) = q(1) + (3 * i)
> -     q(3) = q(3) + (4 * i)
> -     r2(1) = r2(1) + (5 * i)
> -     r2(4) = r2(4) + (6 * i)
> -     if ( (and(fl, 1) /= 0) .and.          &
> -       ((is_64bit_aligned(q(1)) == 0) .or. &
> -       (is_64bit_aligned(p(1)) == 0) .or. &
> -       (is_64bit_aligned(r2(1)) == 0) )) then
> -       stop 15
> -     end if
> +        p(3) = p(3) +  i;
> +        p(4) = p(4) + (2 * i)
> +        q(1) = q(1) + (3 * i)
> +        q(3) = q(3) + (4 * i)
> +        r2(1) = r2(1) + (5 * i)
> +        r2(4) = r2(4) + (6 * i)
> +        if ( (and(fl, 1) /= 0) .and.             &
> +             ((is_64bit_aligned(q(1)) == 0) .or. &
> +              (is_64bit_aligned(p(1)) == 0) .or. &
> +              (is_64bit_aligned(r2(1)) == 0) )) then
> +          stop 15
> +        end if
>      end do
>
>      !$omp task private(y) firstprivate(x) allocate(x, y)
> @@ -305,11 +306,13 @@ subroutine foo (x, p, q, px, h, fl)
>        .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
>      stop 25
>    end if
> -
>  end subroutine
> +end module m
>
>  program main
>    use omp_lib
> +  use m
> +  implicit none (type, external)
>    integer, dimension(4) :: p
>    integer, dimension(4) :: q
>
> @@ -323,11 +326,11 @@ program main
>    if (a == omp_null_allocator) stop 1
>
>    call omp_set_default_allocator (omp_default_mem_alloc);
> -  call foo (42, p, q, 2, a, 0);
> -  call foo (42, p, q, 2, omp_default_mem_alloc, 0);
> -  call foo (42, p, q, 2, a, 1);
> +  call foo (42, p, q, a, 0);
> +  call foo (42, p, q, omp_default_mem_alloc, 0);
> +  call foo (42, p, q, a, 1);
>    call omp_set_default_allocator (a);
> -  call foo (42, p, q, 2, omp_null_allocator, 3);
> -  call foo (42, p, q, 2, omp_default_mem_alloc, 2);
> +  call foo (42, p, q, omp_null_allocator, 3);
> +  call foo (42, p, q, omp_default_mem_alloc, 2);
>    call omp_destroy_allocator (a);
>  end
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955