Always use name from c_interop_kinds_table for -fc-prototypes.
authorThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 19 Jul 2020 15:27:45 +0000 (17:27 +0200)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 19 Jul 2020 15:27:45 +0000 (17:27 +0200)
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.

gcc/fortran/dump-parse-tree.c

index f446488..f9a6bf4 100644 (file)
@@ -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;
            }
        }
     }