[fortran,committed] Fix PR 96220, error with -fc-prototypes

Message ID bbfed397-7acb-7597-e72a-fde2fa32c598@netcologne.de
State New
Headers show
Series
  • [fortran,committed] Fix PR 96220, error with -fc-prototypes
Related show

Commit Message

Jonathan Wakely via Gcc-patches July 19, 2020, 3:38 p.m.
Hello world,

I have just committed the attached patch as simple and obvoius.
The problem was that, for a test case like

module f_global_vars_m
use, intrinsic :: iso_c_binding, sp => c_float, dp => c_double
implicit none
real(dp), bind(c) :: one= 1.0_dp, four= 4.0_dp
end module f_global_vars_m

the code tried to look up the name of the C type in "dp", not
in "c_double".  I removed the code which did the wrong thing,
and let the code that was already there do the work.

I will also backport to gcc 10 and 9 as soon as gcc 10 reopens.

No test case because we can not really test for this (but maybe
we should dump to files instead of standard output for
several of the things that we do dump).

Regards

	Thomas


Always use name from c_interop_kinds_table for -fc-prototypes.

When a user specified a KIND that was a parameter taking the value
of an iso_c_binding KIND, the code used the name of that parameter
to look up the type name.  Corrected by always looking it up in
the table of C interop kinds (which was previously done for
non-C-interop types, anyway).

gcc/fortran/ChangeLog:

         PR fortran/96220
         * dump-parse-tree.c (get_c_type_name): Always use the entries from
         c_interop_kinds_table to find the correct C type.

Patch

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index f44648879f5..f9a6bf4f1f8 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -3257,45 +3257,28 @@  get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre,
   if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX)
     {
       if (ts->is_c_interop && ts->interop_kind)
-	{
-	  *type_name = ts->interop_kind->name + 2;
-	  if (strcmp (*type_name, "signed_char") == 0)
-	    *type_name = "signed char";
-	  else if (strcmp (*type_name, "size_t") == 0)
-	    *type_name = "ssize_t";
-	  else if (strcmp (*type_name, "float_complex") == 0)
-	    *type_name = "__GFORTRAN_FLOAT_COMPLEX";
-	  else if (strcmp (*type_name, "double_complex") == 0)
-	    *type_name = "__GFORTRAN_DOUBLE_COMPLEX";
-	  else if (strcmp (*type_name, "long_double_complex") == 0)
-	    *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
-
-	  ret = T_OK;
-	}
+	ret = T_OK;
       else
+	ret = T_WARN;
+
+      for (int i = 0; i < ISOCBINDING_NUMBER; i++)
 	{
-	  /* The user did not specify a C interop type.  Let's look through
-	     the available table and use the first one, but warn.  */
-	  for (int i = 0; i < ISOCBINDING_NUMBER; i++)
+	  if (c_interop_kinds_table[i].f90_type == ts->type
+	      && c_interop_kinds_table[i].value == ts->kind)
 	    {
-	      if (c_interop_kinds_table[i].f90_type == ts->type
-		  && c_interop_kinds_table[i].value == ts->kind)
-		{
-		  *type_name = c_interop_kinds_table[i].name + 2;
-		  if (strcmp (*type_name, "signed_char") == 0)
-		    *type_name = "signed char";
-		  else if (strcmp (*type_name, "size_t") == 0)
-		    *type_name = "ssize_t";
-		  else if (strcmp (*type_name, "float_complex") == 0)
-		    *type_name = "__GFORTRAN_FLOAT_COMPLEX";
-		  else if (strcmp (*type_name, "double_complex") == 0)
-		    *type_name = "__GFORTRAN_DOUBLE_COMPLEX";
-		  else if (strcmp (*type_name, "long_double_complex") == 0)
-		    *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
-
-		  ret = T_WARN;
-		  break;
-		}
+	      *type_name = c_interop_kinds_table[i].name + 2;
+	      if (strcmp (*type_name, "signed_char") == 0)
+		*type_name = "signed char";
+	      else if (strcmp (*type_name, "size_t") == 0)
+		*type_name = "ssize_t";
+	      else if (strcmp (*type_name, "float_complex") == 0)
+		*type_name = "__GFORTRAN_FLOAT_COMPLEX";
+	      else if (strcmp (*type_name, "double_complex") == 0)
+		*type_name = "__GFORTRAN_DOUBLE_COMPLEX";
+	      else if (strcmp (*type_name, "long_double_complex") == 0)
+		*type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
+
+	      break;
 	    }
 	}
     }