From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 25 Jun 2026 20:55:47 +0000 (+0200)
Subject: Fortran: -fc-prototypes, deferred shape and deferred length dummies [PR125902]
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=fdffb66e398d4440116a7d7834aae11053973ffe;p=thirdparty%2Fgcc.git

Fortran: -fc-prototypes, deferred shape and deferred length dummies [PR125902]

Commit r17-1785 fixed the C prototypes emitted by -fc-prototypes for
procedure interfaces with deferred shape and deferred length dummies, but
did not consistently detect when "#include <ISO_Fortran_binding.h>" was
needed.  Use common helper function to handle this.

	PR fortran/125902

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (needs_CFI_cdesc): New helper function to
	determine when struct CFI_cdesc_t is used.
	(has_cfi_cdesc): Use it here...
	(get_c_type_name): ... and here.

gcc/testsuite/ChangeLog:

	* gfortran.dg/c-prototypes_2.F90: New test.
---

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 3275af3f3ec..19dffe38aed 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -4200,6 +4200,19 @@ static void show_external_symbol (gfc_gsymbol *, void *);
 static void write_type (gfc_symbol *sym);
 static void write_funptr_fcn (gfc_symbol *);
 
+/* Helper function determining if the characteristics of a formal argument of a
+   bind(C) procedure is such that its C prototype needs struct CFI_cdesc_t.  */
+
+static bool
+needs_CFI_cdesc (gfc_typespec *ts, gfc_array_spec *as)
+{
+  return ((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)));
+}
+
 /* Do we need to write out an #include <ISO_Fortran_binding.h> or not?  */
 
 static void
@@ -4224,7 +4237,7 @@ has_cfi_cdesc (gfc_gsymbol *gsym, void *p)
     {
       gfc_symbol *s;
       s = f->sym;
-      if (s->as && (s->as->type == AS_ASSUMED_RANK || s->as->type == AS_ASSUMED_SHAPE))
+      if (needs_CFI_cdesc (&s->ts, s->as))
 	{
 	  *data_p = true;
 	  return;
@@ -4357,11 +4370,7 @@ 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
-	      || as->type == AS_DEFERRED))
-      || (ts->type == BT_CHARACTER
-	  && (ts->deferred || ts->u.cl->length == NULL)))
+  if (needs_CFI_cdesc (ts, as))
     {
       *asterisk = true;
       *post = "";
diff --git a/gcc/testsuite/gfortran.dg/c-prototypes_2.F90 b/gcc/testsuite/gfortran.dg/c-prototypes_2.F90
new file mode 100644
index 00000000000..8530956f956
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c-prototypes_2.F90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-fc-prototypes" }
+!
+! PR fortran/125902
+!
+! Test -fc-prototypes for assumed length character dummy, header include
+
+subroutine sub (b) bind(C)
+  character(*) :: b
+end subroutine sub
+
+#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 sub (CFI_cdesc_t *b);
+
+#ifdef __cplusplus
+}
+#endif
+!{ dg-end-multiline-output "" }
+#endif