Mercurial > hg > CbC > CbC_gcc
diff gcc/fortran/dump-parse-tree.c @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children | 1830386684a0 |
line wrap: on
line diff
--- a/gcc/fortran/dump-parse-tree.c Fri Oct 27 22:46:09 2017 +0900 +++ b/gcc/fortran/dump-parse-tree.c Thu Oct 25 07:37:49 2018 +0900 @@ -1,5 +1,5 @@ /* Parse tree dumper - Copyright (C) 2003-2017 Free Software Foundation, Inc. + Copyright (C) 2003-2018 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. @@ -348,12 +348,10 @@ static void -show_char_const (const gfc_char_t *c, int length) +show_char_const (const gfc_char_t *c, gfc_charlen_t length) { - int i; - fputc ('\'', dumpfile); - for (i = 0; i < length; i++) + for (size_t i = 0; i < (size_t) length; i++) { if (c[i] == '\'') fputs ("''", dumpfile); @@ -465,7 +463,8 @@ break; case BT_HOLLERITH: - fprintf (dumpfile, "%dH", p->representation.length); + fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H", + p->representation.length); c = p->representation.string; for (i = 0; i < p->representation.length; i++, c++) { @@ -717,6 +716,8 @@ fputs (" ELEMENTAL", dumpfile); if (attr->pure) fputs (" PURE", dumpfile); + if (attr->implicit_pure) + fputs (" IMPLICIT_PURE", dumpfile); if (attr->recursive) fputs (" RECURSIVE", dumpfile); @@ -1383,21 +1384,26 @@ const char *type = NULL; switch (list_type) { - case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break; - case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break; - case OMP_LIST_CACHE: type = ""; break; case OMP_LIST_PRIVATE: type = "PRIVATE"; break; case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break; case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break; + case OMP_LIST_COPYPRIVATE: type = "COPYPRIVATE"; break; case OMP_LIST_SHARED: type = "SHARED"; break; case OMP_LIST_COPYIN: type = "COPYIN"; break; case OMP_LIST_UNIFORM: type = "UNIFORM"; break; case OMP_LIST_ALIGNED: type = "ALIGNED"; break; case OMP_LIST_LINEAR: type = "LINEAR"; break; + case OMP_LIST_DEPEND: type = "DEPEND"; break; + case OMP_LIST_MAP: type = "MAP"; break; + case OMP_LIST_TO: type = "TO"; break; + case OMP_LIST_FROM: type = "FROM"; break; case OMP_LIST_REDUCTION: type = "REDUCTION"; break; + case OMP_LIST_DEVICE_RESIDENT: type = "DEVICE_RESIDENT"; break; + case OMP_LIST_LINK: type = "LINK"; break; + case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break; + case OMP_LIST_CACHE: type = "CACHE"; break; case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; - case OMP_LIST_DEPEND: type = "DEPEND"; break; default: gcc_unreachable (); } @@ -1869,6 +1875,22 @@ fputs ("FAIL IMAGE ", dumpfile); break; + case EXEC_CHANGE_TEAM: + fputs ("CHANGE TEAM", dumpfile); + break; + + case EXEC_END_TEAM: + fputs ("END TEAM", dumpfile); + break; + + case EXEC_FORM_TEAM: + fputs ("FORM TEAM", dumpfile); + break; + + case EXEC_SYNC_TEAM: + fputs ("SYNC TEAM", dumpfile); + break; + case EXEC_SYNC_ALL: fputs ("SYNC ALL ", dumpfile); if (c->expr2 != NULL) @@ -3007,7 +3029,6 @@ *type_name = "<error>"; if (ts->type == BT_REAL || ts->type == BT_INTEGER) { - if (ts->is_c_interop && ts->interop_kind) { *type_name = ts->interop_kind->name + 2; @@ -3022,8 +3043,7 @@ { /* 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; i<ISOCBINDING_NUMBER; i++) + 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) @@ -3040,6 +3060,48 @@ } } } + 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) @@ -3083,24 +3145,32 @@ /* 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 @@ -3115,7 +3185,7 @@ 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); } @@ -3137,7 +3207,7 @@ 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); } @@ -3164,7 +3234,7 @@ 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); @@ -3174,7 +3244,14 @@ 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; @@ -3195,9 +3272,10 @@ if (rok == T_WARN) fputs(" /* WARNING: non-interoperable KIND */ ", dumpfile); - fputs (f->next ? ", " : ")", dumpfile); + if (f->next) + fputs(", ", dumpfile); } - fputs (";\n", dumpfile); + fputs (");\n", dumpfile); }