https://gcc.gnu.org/g:38de4e0a8201fdfbda604e447f4b47f2ea9c069c
commit r16-9166-g38de4e0a8201fdfbda604e447f4b47f2ea9c069c Author: Harald Anlauf <[email protected]> Date: Mon Jun 22 22:07:43 2026 +0200 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, as well as for assumed-length scalar character dummies. gcc/testsuite/ChangeLog: * gfortran.dg/c-prototypes_1.F90: New test. (cherry picked from commit e782cebd83be590090216ce3642318f9121991ce) Diff: --- gcc/fortran/dump-parse-tree.cc | 6 ++- gcc/testsuite/gfortran.dg/c-prototypes_1.F90 | 61 ++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index bb54e646f1fc..4f494e20886f 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -4286,7 +4286,11 @@ 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 || ts->u.cl->length == NULL))) { *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 000000000000..8c54f8e7617a --- /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 CFI_cdesc_t *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
