Hi Tobias,
Please see the updated patch attached incorporating your input and
details below.
On 24/10/2023 18:12, you wrote:
On 20.10.23 16:02, Paul-Antoine Arras wrote:
gcc/fortran/ChangeLog:
* interface.cc (gfc_compare_types): Return true in this situation.
That's a bad description. It makes sense when reading the commit log but
if you
only read gcc/fortran/ChangeLog, 'this situation' is a dangling reference.
Updated Changelog with a more helpful description.
gcc/fortran/ChangeLog.omp | 5 ++
gcc/testsuite/ChangeLog.omp | 4 ++
On mainline, the ChangeLog not ChangeLog.omp is used. This changelog is
automatically
filled by the data in the commit log. Thus, no need to include it in the
patch.
Removed ChangeLog.omp from the patch.
See attached patch for a combined version, which checks now
whether from_intmod == INTMOD_ISO_C_BINDING and then compares
the names (to distinguish c_ptr and c_funptr). Those are unaffected
by 'use' renames, hence, we should be fine.
Added the proposed diff for interface.cc and misc.cc to the patch.
Additionally, I think it would be good to have a testcase which checks for
c_funptr vs. c_ptr
mismatch.
Added new testcase c_ptr_tests_21.f90 to check that incompatibilities
between c_funptr vs. c_ptr are properly reported.
Is this latest revision ready to commit?
Thanks,
--
PA
From 691d1050ce39c27231dc610b799bf180871820b8 Mon Sep 17 00:00:00 2001
From: Paul-Antoine Arras <p...@codesourcery.com>
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 <p...@codesourcery.com>
Tobias Burnus <tob...@codesourcery.com>
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
