Hi Paul-Antoine!
On 2024-12-16T19:35:01+0100, Paul-Antoine Arras <par...@baylibre.com> wrote:
> On 15/11/2024 14:59, Tobias Burnus wrote:
>> Paul-Antoine Arras wrote:
>>> This patch adds support for the `dispatch` construct and the
>>> `adjust_args` clause to the Fortran front-end.
>>>
>>> Handling of `adjust_args` across translation units is missing due
>>> to PR115271.
>>
>>
>> First, can you add a run-time test?
>>
>> [I think it helps to have at least one run-time test feature for every
>> major feature - as we had in the past e.g. C runtime tests and Fortran
>> compile time tests - but it turned out that some flags was not set,
>> causing the middle to ignore the feature completely ...]
>
> Added libgomp/testsuite/libgomp.fortran/dispatch-1.f90.
I see this new test case FAIL (execution test SIGSEGV) for most (but not
all) offloading configurations, both GCN and nvptx:
+PASS: libgomp.fortran/dispatch-1.f90 -O (test for excess errors)
+FAIL: libgomp.fortran/dispatch-1.f90 -O execution test
For example:
[...]
Thread 1 "a.out" received signal SIGSEGV, Segmentation fault.
0x00000000004022fc in procedures::bar (d_bv=0x7fffc7002040,
d_av=0x7fffc7000000, n=1024) at
source-gcc/libgomp/testsuite/libgomp.fortran/dispatch-1.f90:59
59 fp_bv(i) = fp_av(i) * i
(gdb) bt
#0 0x00000000004022fc in procedures::bar (d_bv=0x7fffc7002040,
d_av=0x7fffc7000000, n=1024) at
source-gcc/libgomp/testsuite/libgomp.fortran/dispatch-1.f90:59
#1 0x0000000000401c41 in procedures::test (n=1024) at
source-gcc/libgomp/testsuite/libgomp.fortran/dispatch-1.f90:86
#2 0x0000000000402b1e in MAIN__ () at
source-gcc/libgomp/testsuite/libgomp.fortran/dispatch-1.f90:115
(gdb) print i
$1 = 1
(gdb) print fp_bv
$2 = (0, <repeats 200 times>, ...)
(gdb) print fp_av
$3 = (0, <repeats 200 times>, ...)
(gdb) print fp_bv(1)
$4 = 0
(gdb) print fp_av(1)
$5 = 0
(gdb) ptype fp_bv
type = real(kind=8) (1024)
(gdb) ptype fp_av
type = real(kind=8) (1024)
(gdb) up
#1 0x0000000000401c41 in procedures::test (n=1024) at
source-gcc/libgomp/testsuite/libgomp.fortran/dispatch-1.f90:86
86 !$omp dispatch nocontext(n > 1024) novariants(n < 1024)
device(last_dev)
(gdb) print last_dev
$6 = 0
Grüße
Thomas
> --- /dev/null
> +++ libgomp/testsuite/libgomp.fortran/dispatch-1.f90
> @@ -0,0 +1,120 @@
> +module procedures
> + use iso_c_binding, only: c_ptr, c_f_pointer
> + use omp_lib
> + implicit none
> +
> + contains
> +
> + function foo(bv, av, n) result(res)
> + implicit none
> + integer :: res, n, i
> + type(c_ptr) :: bv
> + type(c_ptr) :: av
> + real(8), pointer :: fp_bv(:), fp_av(:) ! Fortran pointers for array
> access
> + !$omp declare variant(bar) match(construct={dispatch})
> adjust_args(need_device_ptr: bv, av)
> + !$omp declare variant(baz) match(implementation={vendor(gnu)})
> +
> + ! Associate C pointers with Fortran pointers
> + call c_f_pointer(bv, fp_bv, [n])
> + call c_f_pointer(av, fp_av, [n])
> +
> + ! Perform operations using Fortran pointers
> + do i = 1, n
> + fp_bv(i) = fp_av(i) * i
> + end do
> + res = -1
> + end function foo
> +
> + function baz(d_bv, d_av, n) result(res)
> + implicit none
> + integer :: res, n, i
> + type(c_ptr) :: d_bv
> + type(c_ptr) :: d_av
> + real(8), pointer :: fp_bv(:), fp_av(:) ! Fortran pointers for array
> access
> +
> + ! Associate C pointers with Fortran pointers
> + call c_f_pointer(d_bv, fp_bv, [n])
> + call c_f_pointer(d_av, fp_av, [n])
> +
> + !$omp distribute parallel do
> + do i = 1, n
> + fp_bv(i) = fp_av(i) * i
> + end do
> + res = -3
> + end function baz
> +
> + function bar(d_bv, d_av, n) result(res)
> + implicit none
> + integer :: res, n, i
> + type(c_ptr) :: d_bv
> + type(c_ptr) :: d_av
> + real(8), pointer :: fp_bv(:), fp_av(:) ! Fortran pointers for array
> access
> +
> + ! Associate C pointers with Fortran pointers
> + call c_f_pointer(d_bv, fp_bv, [n])
> + call c_f_pointer(d_av, fp_av, [n])
> +
> + ! Perform operations on target
> + do i = 1, n
> + fp_bv(i) = fp_av(i) * i
> + end do
> + res = -2
> + end function bar
> +
> + function test(n) result(res)
> + use iso_c_binding, only: c_ptr, c_loc
> + implicit none
> + integer :: n, res, i, f, ff, last_dev
> + real(8), allocatable, target :: av(:), bv(:), d_bv(:)
> + real(8), parameter :: e = 2.71828d0
> + type(c_ptr) :: c_av, c_bv, c_d_bv
> +
> + allocate(av(n), bv(n), d_bv(n))
> +
> + ! Initialize arrays
> + do i = 1, n
> + av(i) = e * i
> + bv(i) = 0.0d0
> + d_bv(i) = 0.0d0
> + end do
> +
> + last_dev = omp_get_num_devices() - 1
> +
> + c_av = c_loc(av)
> + c_d_bv = c_loc(d_bv)
> + !$omp target data map(to: av(:n)) map(from: d_bv(:n)) device(last_dev)
> if(n == 1024)
> + !$omp dispatch nocontext(n > 1024) novariants(n < 1024)
> device(last_dev)
> + f = foo(c_d_bv, c_av, n)
> + !$omp end target data
> +
> + c_bv = c_loc(bv)
> + ff = foo(c_bv, c_loc(av), n)
> +
> + ! Verify results
> + do i = 1, n
> + if (d_bv(i) /= bv(i)) then
> + write(0,*) 'ERROR at ', i, ': ', d_bv(i), ' (act) != ', bv(i), '
> (exp)'
> + res = 1
> + return
> + end if
> + end do
> +
> + res = f
> + deallocate(av, bv, d_bv)
> + end function test
> +end module procedures
> +
> +program main
> + use procedures
> + implicit none
> + integer :: ret
> +
> + ret = test(1023)
> + if (ret /= -1) stop 1
> +
> + ret = test(1024)
> + if (ret /= -2) stop 1
> +
> + ret = test(1025)
> + if (ret /= -3) stop 1
> +end program main
