From 691d1050ce39c27231dc610b799bf180871820b8 Mon Sep 17 00:00:00 2001 From: Paul-Antoine Arras Date: Fri, 20 Oct 2023 12:42:49 +0200 Subject: [PATCH] Fortran: Fix incompatible types between INTEGER(8) and TYPE(c_ptr) In the context of an OpenMP declare variant directive, arguments of type C_PTR are sometimes recognised as C_PTR in the base function and as INTEGER(8) in the variant - or the other way around, depending on the parsing order. This patch prevents such situation from turning into a compile error. 2023-10-20 Paul-Antoine Arras Tobias Burnus gcc/fortran/ChangeLog: * interface.cc (gfc_compare_types): Return true if one type is C_PTR and the other is a compatible INTEGER(8). * misc.cc (gfc_typename): Handle the case where an INTEGER(8) actually holds a TYPE(C_PTR). gcc/testsuite/ChangeLog: * gfortran.dg/c_ptr_tests_20.f90: New test, checking that INTEGER(8) and TYPE(C_PTR) are recognised as compatible. * gfortran.dg/c_ptr_tests_21.f90: New test, exercising the error detection for C_FUNPTR. --- gcc/fortran/interface.cc | 16 ++++-- gcc/fortran/misc.cc | 7 ++- gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90 | 57 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/c_ptr_tests_21.f90 | 57 ++++++++++++++++++++ 4 files changed, 132 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90 create mode 100644 gcc/testsuite/gfortran.dg/c_ptr_tests_21.f90 diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index e9843e9549c..ed1613b16fb 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -707,10 +707,18 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) better way of doing this. When ISO C binding is cleared up, this can probably be removed. See PR 57048. */ - if (((ts1->type == BT_INTEGER && ts2->type == BT_DERIVED) - || (ts1->type == BT_DERIVED && ts2->type == BT_INTEGER)) - && ts1->u.derived && ts2->u.derived - && ts1->u.derived == ts2->u.derived) + if ((ts1->type == BT_INTEGER + && ts2->type == BT_DERIVED + && ts1->f90_type == BT_VOID + && ts2->u.derived->from_intmod == INTMOD_ISO_C_BINDING + && ts1->u.derived + && strcmp (ts1->u.derived->name, ts2->u.derived->name) == 0) + || (ts2->type == BT_INTEGER + && ts1->type == BT_DERIVED + && ts2->f90_type == BT_VOID + && ts1->u.derived->from_intmod == INTMOD_ISO_C_BINDING + && ts2->u.derived + && strcmp (ts1->u.derived->name, ts2->u.derived->name) == 0)) return true; /* The _data component is not always present, therefore check for its diff --git a/gcc/fortran/misc.cc b/gcc/fortran/misc.cc index bae6d292dc5..edffba07013 100644 --- a/gcc/fortran/misc.cc +++ b/gcc/fortran/misc.cc @@ -138,7 +138,12 @@ gfc_typename (gfc_typespec *ts, bool for_hash) switch (ts->type) { case BT_INTEGER: - sprintf (buffer, "INTEGER(%d)", ts->kind); + if (ts->f90_type == BT_VOID + && ts->u.derived + && ts->u.derived->from_intmod == INTMOD_ISO_C_BINDING) + sprintf (buffer, "TYPE(%s)", ts->u.derived->name); + else + sprintf (buffer, "INTEGER(%d)", ts->kind); break; case BT_REAL: sprintf (buffer, "REAL(%d)", ts->kind); diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90 new file mode 100644 index 00000000000..7dd510400f3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90 @@ -0,0 +1,57 @@ +! { dg-do compile } +! { dg-additional-options "-fopenmp" } +! +! This failed to compile the declare variant directive due to the C_PTR +! arguments to foo being recognised as INTEGER(8) + +program adjust_args + use iso_c_binding, only: c_loc + implicit none + + integer, parameter :: N = 1024 + real, allocatable, target :: av(:), bv(:), cv(:) + + call foo(c_loc(bv), c_loc(av), N) + + !$omp target data map(to: av(:N)) map(from: cv(:N)) + !$omp parallel + call foo(c_loc(cv), c_loc(av), N) + !$omp end parallel + !$omp end target data + +contains + subroutine foo_variant(c_d_bv, c_d_av, n) + use iso_c_binding, only: c_ptr, c_f_pointer + type(c_ptr), intent(in) :: c_d_bv, c_d_av + integer, intent(in) :: n + real, pointer :: f_d_bv(:) + real, pointer :: f_d_av(:) + integer :: i + + call c_f_pointer(c_d_bv, f_d_bv, [n]) + call c_f_pointer(c_d_av, f_d_av, [n]) + !$omp target teams loop is_device_ptr(f_d_bv, f_d_av) + do i = 1, n + f_d_bv(i) = f_d_av(i) * i + end do + end subroutine + + + subroutine foo(c_bv, c_av, n) + use iso_c_binding, only: c_ptr, c_f_pointer + type(c_ptr), intent(in) :: c_bv, c_av + integer, intent(in) :: n + real, pointer :: f_bv(:) + real, pointer :: f_av(:) + integer :: i + !$omp declare variant(foo_variant) & + !$omp match(construct={parallel}) + + call c_f_pointer(c_bv, f_bv, [n]) + call c_f_pointer(c_av, f_av, [n]) + !$omp parallel loop + do i = 1, n + f_bv(i) = f_av(i) * i + end do + end subroutine +end program diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_21.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_21.f90 new file mode 100644 index 00000000000..05ccb771eee --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_21.f90 @@ -0,0 +1,57 @@ +! { dg-do compile } +! { dg-additional-options "-fopenmp" } +! +! Ensure that C_PTR and C_FUNPTR are reported as incompatible types in variant +! argument lists + +program adjust_args + use iso_c_binding, only: c_loc + implicit none + + integer, parameter :: N = 1024 + real, allocatable, target :: av(:), bv(:), cv(:) + + call foo(c_loc(bv), c_loc(av), N) + + !$omp target data map(to: av(:N)) map(from: cv(:N)) + !$omp parallel + call foo(c_loc(cv), c_loc(av), N) + !$omp end parallel + !$omp end target data + +contains + subroutine foo_variant(c_d_bv, c_d_av, n) + use iso_c_binding, only: c_funptr, c_f_pointer + type(c_funptr), intent(in) :: c_d_bv, c_d_av + integer, intent(in) :: n + real, pointer :: f_d_bv(:) + real, pointer :: f_d_av(:) + integer :: i + +! call c_f_pointer(c_d_bv, f_d_bv, [n]) +! call c_f_pointer(c_d_av, f_d_av, [n]) + !$omp target teams loop is_device_ptr(f_d_bv, f_d_av) + do i = 1, n + f_d_bv(i) = f_d_av(i) * i + end do + end subroutine + + + subroutine foo(c_bv, c_av, n) + use iso_c_binding, only: c_ptr, c_f_pointer + type(c_ptr), intent(in) :: c_bv, c_av + integer, intent(in) :: n + real, pointer :: f_bv(:) + real, pointer :: f_av(:) + integer :: i + !$omp declare variant(foo_variant) & ! { dg-error "variant 'foo_variant' and base 'foo' at .1. have incompatible types: Type mismatch in argument 'c_bv' .TYPE.c_ptr./TYPE.c_funptr.." } + !$omp match(construct={parallel}) + + call c_f_pointer(c_bv, f_bv, [n]) + call c_f_pointer(c_av, f_av, [n]) + !$omp parallel loop + do i = 1, n + f_bv(i) = f_av(i) * i + end do + end subroutine +end program -- 2.42.0