Dear All, the attached patch adjust the checks for interoperability of procedures, the conditions of which were relaxed in F2018.
The testcase is based on the one provided by the reporter. The added examples of interoperable subroutines for the further cases are not really needed, as they are already technically covered elsewhere by the bind(c) tests in the testsuite. I simply left them there to see for myself (-fdump-tree-original) that we get these cases right. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From 7e59fea021fdf07e76bd09cf3c982187f12d9cba Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Fri, 7 Nov 2025 22:22:42 +0100 Subject: [PATCH] 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. --- gcc/fortran/decl.cc | 40 +++++++++- .../gfortran.dg/c-interop/pr113338-c.c | 10 +++ .../gfortran.dg/c-interop/pr113338.f90 | 80 +++++++++++++++++++ 3 files changed, 129 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/c-interop/pr113338-c.c create mode 100644 gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 96ee6bf7b68..03134f39a40 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 00000000000..21a6b7a007a --- /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 00000000000..a83c3ca93fa --- /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 -- 2.51.0
