https://gcc.gnu.org/g:5398158b98a26648ce7412344a44312e924a52f0
commit r16-5098-g5398158b98a26648ce7412344a44312e924a52f0 Author: Harald Anlauf <[email protected]> Date: Fri Nov 7 22:22:42 2025 +0100 Fortran: F2018 extensions to interoperability of procedures [PR113338] PR fortran/113338 gcc/fortran/ChangeLog: * decl.cc (gfc_verify_c_interop_param): Allow further types of dummy argument without the VALUE attribute as specified in F2018 18.3.6 item (5). gcc/testsuite/ChangeLog: * gfortran.dg/c-interop/pr113338-c.c: New test. * gfortran.dg/c-interop/pr113338.f90: New test. Diff: --- gcc/fortran/decl.cc | 40 +++++++++++- gcc/testsuite/gfortran.dg/c-interop/pr113338-c.c | 10 +++ gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 | 80 ++++++++++++++++++++++++ 3 files changed, 129 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 96ee6bf7b686..03134f39a404 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1537,9 +1537,47 @@ gfc_verify_c_interop_param (gfc_symbol *sym) { if (sym->ns->proc_name->attr.is_bind_c == 1) { + bool f2018_allowed = gfc_option.allow_std & ~GFC_STD_OPT_F08; + bool f2018_added = false; + is_c_interop = (gfc_verify_c_interop(&(sym->ts)) ? 1 : 0); - if (is_c_interop != 1) + /* F2018:18.3.6 has the following text: + "(5) any dummy argument without the VALUE attribute corresponds to + a formal parameter of the prototype that is of a pointer type, and + either + • the dummy argument is interoperable with an entity of the + referenced type (ISO/IEC 9899:2011, 6.2.5, 7.19, and 7.20.1) of + the formal parameter (this is equivalent to the F2008 text), + • the dummy argument is a nonallocatable nonpointer variable of + type CHARACTER with assumed character length and the formal + parameter is a pointer to CFI_cdesc_t, + • the dummy argument is allocatable, assumed-shape, assumed-rank, + or a pointer without the CONTIGUOUS attribute, and the formal + parameter is a pointer to CFI_cdesc_t, or + • the dummy argument is assumed-type and not allocatable, + assumed-shape, assumed-rank, or a pointer, and the formal + parameter is a pointer to void," */ + if (is_c_interop == 0 && !sym->attr.value && f2018_allowed) + { + bool as_ar = (sym->as + && (sym->as->type == AS_ASSUMED_SHAPE + || sym->as->type == AS_ASSUMED_RANK)); + bool cond1 = (sym->ts.type == BT_CHARACTER + && !(sym->ts.u.cl && sym->ts.u.cl->length) + && !sym->attr.allocatable + && !sym->attr.pointer); + bool cond2 = (sym->attr.allocatable + || as_ar + || (IS_POINTER (sym) && !sym->attr.contiguous)); + bool cond3 = (sym->ts.type == BT_ASSUMED + && !sym->attr.allocatable + && !sym->attr.pointer + && !as_ar); + f2018_added = cond1 || cond2 || cond3; + } + + if (is_c_interop != 1 && !f2018_added) { /* Make personalized messages to give better feedback. */ if (sym->ts.type == BT_DERIVED) diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr113338-c.c b/gcc/testsuite/gfortran.dg/c-interop/pr113338-c.c new file mode 100644 index 000000000000..21a6b7a007a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr113338-c.c @@ -0,0 +1,10 @@ +/* PR fortran/113338. */ + +#include <ISO_Fortran_binding.h> + +extern void f_proc(CFI_cdesc_t* x); + +extern void c_proc(CFI_cdesc_t* x) +{ + f_proc(x); +} diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 new file mode 100644 index 000000000000..a83c3ca93faa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 @@ -0,0 +1,80 @@ +! { dg-do run } +! { dg-additional-sources pr113338-c.c } +! { dg-additional-options "-Wno-error -O2 -std=f2018" } +! { dg-warning "command-line option '-std=f2018' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! +! PR fortran/113338 - F2018 extensions to interoperability of procedures + +program example + use iso_c_binding + implicit none + + type :: t + integer :: i + end type + + interface + subroutine c_proc(x) bind(c) + import t + type(t), pointer, intent(in) :: x + end subroutine c_proc + end interface + + type(t), target :: x + + x%i = 42 + call c_proc(x) +end program + +! pointer +subroutine f_proc(x) bind(c) + type :: t + integer :: i + end type t + type(t), pointer, intent(in) :: x + if (.not. associated (x)) stop 1 +! print *, x%i + if (x%i /= 42) stop 2 +end subroutine f_proc + +!----------------------------------------------------------------------- +! Further cases some of which are also tested elsewhere in the testsuite +!----------------------------------------------------------------------- + +! character: length 1 or assumed character length -> *CFI_cdesc_t +subroutine f_char(c, s) bind(c) + character :: c(:) + character(*) :: s(:) +end subroutine f_char + +! allocatable: scalar, assumed-shape, assumed-rank -> *CFI_cdesc_t +subroutine f_a(x, y, z) bind(c) + type :: t + integer :: i + end type t + type(t), allocatable :: x + type(t), allocatable :: y(:) + type(t), allocatable :: z(..) +end subroutine f_a + +! pointer: scalar, assumed-shape, assumed-rank -> *CFI_cdesc_t +subroutine f_p(x, y, z) bind(c) + type :: t + integer :: i + end type t + type(t), pointer :: x + type(t), pointer :: y(:) + type(t), pointer :: z(..) +end subroutine f_p + +! assumed-type: assumed shape, assumed rank -> *CFI_cdesc_t +subroutine f_at_cfi(z, w) bind(c) + type(*) :: z(:) + type(*) :: w(..) +end subroutine f_at_cfi + +! assumed-type: scalar, assumed-size -> *void +subroutine f_at_void(x, y) bind(c) + type(*) :: x + type(*) :: y(*) +end subroutine f_at_void
