From: Thomas Koenig Date: Sat, 13 Jan 2018 18:22:36 +0000 (+0000) Subject: re PR fortran/83744 (ICE in ../../gcc/gcc/fortran/dump-parse-tree.c:3093 while using... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=39f309aca6e6b756ffab4222ffc39094042b9413;p=gcc.git re PR fortran/83744 (ICE in ../../gcc/gcc/fortran/dump-parse-tree.c:3093 while using -fc-prototypes) 2018-01-13 Thomas Koenig PR fortran/83744 * dump-parse-tree.c (get_c_type_name): Remove extra line. Change for loop to use declaration in for loop. Handle BT_LOGICAL and BT_CHARACTER. (write_decl): Add where argument. Fix indentation. Replace assert with error message. Add typename to warning in comment. (write_type): Adjust locus to call of write_decl. (write_variable): Likewise. (write_proc): Likewise. Replace assert with error message. From-SVN: r256645 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1e421d9027d..d7ec5806f82 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2018-01-13 Thomas Koenig + + PR fortran/83744 + * dump-parse-tree.c (get_c_type_name): Remove extra line. + Change for loop to use declaration in for loop. Handle BT_LOGICAL + and BT_CHARACTER. + (write_decl): Add where argument. Fix indentation. Replace + assert with error message. Add typename to warning + in comment. + (write_type): Adjust locus to call of write_decl. + (write_variable): Likewise. + (write_proc): Likewise. Replace assert with error message. + 2018-01-13 Paul Thomas PR fortran/52162 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 5ead416e523..5ff531682e3 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -3006,7 +3006,6 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, *type_name = ""; if (ts->type == BT_REAL || ts->type == BT_INTEGER) { - if (ts->is_c_interop && ts->interop_kind) { *type_name = ts->interop_kind->name + 2; @@ -3021,8 +3020,7 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, { /* The user did not specify a C interop type. Let's look through the available table and use the first one, but warn. */ - int i; - for (i=0; itype && c_interop_kinds_table[i].value == ts->kind) @@ -3039,6 +3037,48 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, } } } + else if (ts->type == BT_LOGICAL) + { + if (ts->is_c_interop && ts->interop_kind) + { + *type_name = "_Bool"; + ret = T_OK; + } + else + { + /* Let's select an appropriate int, with a warning. */ + for (int i = 0; i < ISOCBINDING_NUMBER; i++) + { + if (c_interop_kinds_table[i].f90_type == BT_INTEGER + && c_interop_kinds_table[i].value == ts->kind) + { + *type_name = c_interop_kinds_table[i].name + 2; + ret = T_WARN; + } + } + } + } + else if (ts->type == BT_CHARACTER) + { + if (ts->is_c_interop) + { + *type_name = "char"; + ret = T_OK; + } + else + { + /* Let's select an appropriate int, with a warning. */ + for (int i = 0; i < ISOCBINDING_NUMBER; i++) + { + if (c_interop_kinds_table[i].f90_type == BT_INTEGER + && c_interop_kinds_table[i].value == ts->kind) + { + *type_name = c_interop_kinds_table[i].name + 2; + ret = T_WARN; + } + } + } + } else if (ts->type == BT_DERIVED) { if (ts->u.derived->from_intmod == INTMOD_ISO_C_BINDING) @@ -3082,24 +3122,32 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, /* Write out a declaration. */ static void write_decl (gfc_typespec *ts, gfc_array_spec *as, const char *sym_name, - bool func_ret) + bool func_ret, locus *where) { - const char *pre, *type_name, *post; - bool asterisk; - enum type_return rok; - - rok = get_c_type_name (ts, as, &pre, &type_name, &asterisk, &post, func_ret); - gcc_assert (rok != T_ERROR); - fputs (type_name, dumpfile); - fputs (pre, dumpfile); - if (asterisk) - fputs ("*", dumpfile); - - fputs (sym_name, dumpfile); - fputs (post, dumpfile); + const char *pre, *type_name, *post; + bool asterisk; + enum type_return rok; + + rok = get_c_type_name (ts, as, &pre, &type_name, &asterisk, &post, func_ret); + if (rok == T_ERROR) + { + gfc_error_now ("Cannot convert %qs to interoperable type at %L", + gfc_typename (ts), where); + fprintf (dumpfile, "/* Cannot convert '%s' to interoperable type */", + gfc_typename (ts)); + return; + } + fputs (type_name, dumpfile); + fputs (pre, dumpfile); + if (asterisk) + fputs ("*", dumpfile); + + fputs (sym_name, dumpfile); + fputs (post, dumpfile); - if (rok == T_WARN) - fputs(" /* WARNING: non-interoperable KIND */", dumpfile); + if (rok == T_WARN) + fprintf (dumpfile," /* WARNING: Converting '%s' to interoperable type */", + gfc_typename (ts)); } /* Write out an interoperable type. It will be written as a typedef @@ -3114,7 +3162,7 @@ write_type (gfc_symbol *sym) for (c = sym->components; c; c = c->next) { fputs (" ", dumpfile); - write_decl (&(c->ts), c->as, c->name, false); + write_decl (&(c->ts), c->as, c->name, false, &sym->declared_at); fputs (";\n", dumpfile); } @@ -3136,7 +3184,7 @@ write_variable (gfc_symbol *sym) sym_name = sym->name; fputs ("extern ", dumpfile); - write_decl (&(sym->ts), sym->as, sym_name, false); + write_decl (&(sym->ts), sym->as, sym_name, false, &sym->declared_at); fputs (";\n", dumpfile); } @@ -3163,7 +3211,7 @@ write_proc (gfc_symbol *sym) fputs (sym_name, dumpfile); } else - write_decl (&(sym->ts), sym->as, sym->name, true); + write_decl (&(sym->ts), sym->as, sym->name, true, &sym->declared_at); fputs (" (", dumpfile); @@ -3173,7 +3221,14 @@ write_proc (gfc_symbol *sym) s = f->sym; rok = get_c_type_name (&(s->ts), NULL, &pre, &type_name, &asterisk, &post, false); - gcc_assert (rok != T_ERROR); + if (rok == T_ERROR) + { + gfc_error_now ("Cannot convert %qs to interoperable type at %L", + gfc_typename (&s->ts), &s->declared_at); + fprintf (stderr, "/* Cannot convert '%s' to interoperable type */", + gfc_typename (&s->ts)); + return; + } if (!s->attr.value) asterisk = true;