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 3275af3f3ec8fa70f79aa4bf594595f1ed3d5212..19dffe38aed34eaa5e57a9cfcef265b1f54c2358 100644 (file)
--- 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 (file)
index 0000000..8530956
--- /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