Dear all, the subject already says it: we emitted the wrong C prototypes for deferred shape and deferred length dummies of interoperable procedures. Here we need to pass pointers to a CFI_cdesc_t structure.
There seems to be no existing testcase exercising -fc-prototypes, unless I missed it. This one tests the output emitted by the frontend. OK for mainline / backport to 16-branch? Thanks, Harald
From 5a380ca05e85dac5fe2dac95a6e4378946d4dedc Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Mon, 22 Jun 2026 22:07:43 +0200 Subject: [PATCH] Fortran: -fc-prototypes, deferred shape and deferred length dummies [PR125902] PR fortran/125902 gcc/fortran/ChangeLog: * dump-parse-tree.cc (get_c_type_name): Use CFI_cdesc_t also for deferred shape and deferred length dummies. gcc/testsuite/ChangeLog: * gfortran.dg/c-prototypes_1.F90: New test. --- gcc/fortran/dump-parse-tree.cc | 5 +- gcc/testsuite/gfortran.dg/c-prototypes_1.F90 | 61 ++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/c-prototypes_1.F90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index b2bb7fc2269..6f5ce1b034c 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -4357,7 +4357,10 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, *post = ""; *type_name = "<error>"; - if (as && (as->type == AS_ASSUMED_RANK || as->type == AS_ASSUMED_SHAPE)) + if ((as && (as->type == AS_ASSUMED_RANK + || as->type == AS_ASSUMED_SHAPE + || as->type == AS_DEFERRED)) + || (ts->type == BT_CHARACTER && ts->deferred)) { *asterisk = true; *post = ""; diff --git a/gcc/testsuite/gfortran.dg/c-prototypes_1.F90 b/gcc/testsuite/gfortran.dg/c-prototypes_1.F90 new file mode 100644 index 00000000000..693b2f2379d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c-prototypes_1.F90 @@ -0,0 +1,61 @@ +! { dg-do compile } +! { dg-options "-fc-prototypes" } +! +! PR fortran/125902 +! +! Test -fc-prototypes for deferred shape and deferred length dummies + +module test_c_prototypes_module + + use iso_c_binding + implicit none (type, external) + + interface + subroutine testsub1(b, c, d, r, ier) bind(C) + import + character(kind=c_char,len=*), intent(in) :: b + real(c_float), dimension(:), intent(inout) :: c + real(c_double), dimension(:), allocatable, intent(inout) :: d + character(kind=c_char,len=:), allocatable, intent(inout) :: r + integer(c_int), intent(out) :: ier + end subroutine testsub1 + end interface + + interface + subroutine testsub2(b, msg, c, d, r) bind(C) + import + character(kind=c_char), intent(in) :: b(:) + character(kind=c_char), intent(out) :: msg(*) + real(c_float), dimension(*), intent(inout) :: c + real(c_double), dimension(:), pointer, intent(inout) :: d + character(kind=c_char,len=:), pointer, intent(inout) :: r + end subroutine testsub2 + end interface + +end module test_c_prototypes_module + +#if 0 +!{ dg-begin-multiline-output "" } +#include <stddef.h> +#ifdef __cplusplus +#include <complex> +#define __GFORTRAN_FLOAT_COMPLEX std::complex<float> +#define __GFORTRAN_DOUBLE_COMPLEX std::complex<double> +#define __GFORTRAN_LONG_DOUBLE_COMPLEX std::complex<long double> +extern "C" { +#else +#define __GFORTRAN_FLOAT_COMPLEX float _Complex +#define __GFORTRAN_DOUBLE_COMPLEX double _Complex +#define __GFORTRAN_LONG_DOUBLE_COMPLEX long double _Complex +#endif + +#include <ISO_Fortran_binding.h> + +void testsub1 (const char *b, CFI_cdesc_t *c, CFI_cdesc_t *d, CFI_cdesc_t *r, int *ier); +void testsub2 (const CFI_cdesc_t *b, char *msg, float *c, CFI_cdesc_t *d, CFI_cdesc_t *r); + +#ifdef __cplusplus +} +#endif +!{ dg-end-multiline-output "" } +#endif -- 2.51.0
