From 2e1b25350aa96b3f5678a056d0b55bb323c452d9 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 19 Jul 2020 17:27:45 +0200 Subject: [PATCH] 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. --- gcc/fortran/dump-parse-tree.c | 55 ++++++++++++----------------------- 1 file changed, 19 insertions(+), 36 deletions(-) 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; } } } -- 2.30.2