From: Thomas Koenig Date: Mon, 29 Jul 2019 17:45:24 +0000 (+0000) Subject: re PR fortran/90813 (gfortran.dg/proc_ptr_51.f90 fails (SIGSEGV) after 272084) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5c6aa9a8919cbf0dcf3c375f51012720bfb5f3a1;p=gcc.git re PR fortran/90813 (gfortran.dg/proc_ptr_51.f90 fails (SIGSEGV) after 272084) 2019-07-29 Thomas Koenig PR fortran/90813 * dump-parse-tree.c (show_global_symbol): New function. (gfc_dump_global_symbols): New function. * gfortran.h (gfc_traverse_gsymbol): Add prototype. (gfc_dump_global_symbols): Likewise. * invoke.texi: Document -fdump-fortran-global. * lang.opt: Add -fdump-fortran-global. * parse.c (gfc_parse_file): Handle flag_dump_fortran_global. * symbol.c (gfc_traverse_gsymbol): New function. * trans-decl.c (sym_identifier): New function. (mangled_identifier): New function, doing most of the work of gfc_sym_mangled_identifier. (gfc_sym_mangled_identifier): Use mangled_identifier. Add mangled identifier to global symbol table. (get_proc_pointer_decl): Use backend decl from global identifier if present. From-SVN: r273880 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index faca1a0657c..dc965eae61b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2019-07-29 Thomas Koenig + + PR fortran/90813 + * dump-parse-tree.c (show_global_symbol): New function. + (gfc_dump_global_symbols): New function. + * gfortran.h (gfc_traverse_gsymbol): Add prototype. + (gfc_dump_global_symbols): Likewise. + * invoke.texi: Document -fdump-fortran-global. + * lang.opt: Add -fdump-fortran-global. + * parse.c (gfc_parse_file): Handle flag_dump_fortran_global. + * symbol.c (gfc_traverse_gsymbol): New function. + * trans-decl.c (sym_identifier): New function. + (mangled_identifier): New function, doing most of the work + of gfc_sym_mangled_identifier. + (gfc_sym_mangled_identifier): Use mangled_identifier. Add mangled + identifier to global symbol table. + (get_proc_pointer_decl): Use backend decl from global identifier + if present. + 2019-07-25 Thomas Koenig PR fortran/65819 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 4cff8059b73..798519fa6af 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -3462,3 +3462,36 @@ write_interop_decl (gfc_symbol *sym) else if (sym->attr.flavor == FL_PROCEDURE) write_proc (sym, true); } + +/* This section deals with dumping the global symbol tree. */ + +/* Callback function for printing out the contents of the tree. */ + +static void +show_global_symbol (gfc_gsymbol *gsym, void *f_data) +{ + FILE *out; + out = (FILE *) f_data; + + if (gsym->name) + fprintf (out, "name=%s", gsym->name); + + if (gsym->sym_name) + fprintf (out, ", sym_name=%s", gsym->sym_name); + + if (gsym->mod_name) + fprintf (out, ", mod_name=%s", gsym->mod_name); + + if (gsym->binding_label) + fprintf (out, ", binding_label=%s", gsym->binding_label); + + fputc ('\n', out); +} + +/* Show all global symbols. */ + +void +gfc_dump_global_symbols (FILE *f) +{ + gfc_traverse_gsymbol (gfc_gsym_root, show_global_symbol, (void *) f); +} diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 700e6dcbcd8..aad9e10efca 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3128,6 +3128,7 @@ void gfc_enforce_clean_symbol_state (void); gfc_gsymbol *gfc_get_gsymbol (const char *, bool bind_c); gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); gfc_gsymbol *gfc_find_case_gsymbol (gfc_gsymbol *, const char *); +void gfc_traverse_gsymbol (gfc_gsymbol *, void (*)(gfc_gsymbol *, void *), void *); gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*); gfc_symbol* gfc_get_derived_super_type (gfc_symbol*); @@ -3471,6 +3472,7 @@ void gfc_delete_bbt (void *, void *, compare_fn); void gfc_dump_parse_tree (gfc_namespace *, FILE *); void gfc_dump_c_prototypes (gfc_namespace *, FILE *); void gfc_dump_external_c_prototypes (FILE *); +void gfc_dump_global_symbols (FILE *); /* parse.c */ bool gfc_parse_file (void); diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 5d538faae38..3c1b2ac7a26 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -157,7 +157,8 @@ and warnings}. @item Debugging Options @xref{Debugging Options,,Options for debugging your program or GNU Fortran}. @gccoptlist{-fbacktrace -fdump-fortran-optimized -fdump-fortran-original @gol --fdump-parse-tree -ffpe-trap=@var{list} -ffpe-summary=@var{list} +-fdump-fortran-global -fdump-parse-tree -ffpe-trap=@var{list} @gol +-ffpe-summary=@var{list} } @item Directory Options @@ -1199,6 +1200,14 @@ change between releases. This option may also generate internal compiler errors for features which have only recently been added. This option is deprecated; use @code{-fdump-fortran-original} instead. +@item -fdump-fortran-global +@opindex @code{fdump-fortran-global} +Output a list of the global identifiers after translating into +middle-end representation. Mostly useful for debugging the GNU Fortran +compiler itself. The output generated by this option might change +between releases. This option may also generate internal compiler +errors for features which have only recently been added. + @item -ffpe-trap=@var{list} @opindex @code{ffpe-trap=}@var{list} Specify a list of floating point exception traps to enable. On most diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index fdf5061b64f..85113a7da1e 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -512,6 +512,10 @@ fdump-fortran-optimized Fortran Var(flag_dump_fortran_optimized) Display the code tree after front end optimization. +fdump-fortran-global +Fortran Var(flag_dump_fortran_global) +Display the global symbol table after parsing. + fdump-parse-tree Fortran Alias(fdump-fortran-original) Display the code tree after parsing; deprecated option. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 8947299bc1f..66d84b4118f 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -6366,6 +6366,13 @@ done: /* Do the translation. */ translate_all_program_units (gfc_global_ns_list); + /* Dump the global symbol ist. We only do this here because part + of it is generated after mangling the identifiers in + trans-decl.c. */ + + if (flag_dump_fortran_global) + gfc_dump_global_symbols (stdout); + gfc_end_source_files (); return true; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index f4273633db7..2b8f86e0881 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4357,6 +4357,19 @@ gfc_get_gsymbol (const char *name, bool bind_c) return s; } +void +gfc_traverse_gsymbol (gfc_gsymbol *gsym, + void (*do_something) (gfc_gsymbol *, void *), + void *data) +{ + if (gsym->left) + gfc_traverse_gsymbol (gsym->left, do_something, data); + + (*do_something) (gsym, data); + + if (gsym->right) + gfc_traverse_gsymbol (gsym->right, do_something, data); +} static gfc_symbol * get_iso_c_binding_dt (int sym_id) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 64ce4bba23d..96f0e1e56d2 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -345,39 +345,45 @@ gfc_get_label_decl (gfc_st_label * lp) } } +/* Return the name of an identifier. */ -/* Convert a gfc_symbol to an identifier of the same name. */ - -static tree -gfc_sym_identifier (gfc_symbol * sym) +static const char * +sym_identifier (gfc_symbol *sym) { if (sym->attr.is_main_program && strcmp (sym->name, "main") == 0) - return (get_identifier ("MAIN__")); + return "MAIN__"; else - return (get_identifier (sym->name)); + return sym->name; } - -/* Construct mangled name from symbol name. */ +/* Convert a gfc_symbol to an identifier of the same name. */ static tree -gfc_sym_mangled_identifier (gfc_symbol * sym) +gfc_sym_identifier (gfc_symbol * sym) { - char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1]; + return get_identifier (sym_identifier (sym)); +} +/* Construct mangled name from symbol name. */ + +static const char * +mangled_identifier (gfc_symbol *sym) +{ + static char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1]; /* Prevent the mangling of identifiers that have an assigned binding label (mainly those that are bind(c)). */ + if (sym->attr.is_bind_c == 1 && sym->binding_label) - return get_identifier (sym->binding_label); + return sym->binding_label; if (!sym->fn_result_spec) { if (sym->module == NULL) - return gfc_sym_identifier (sym); + return sym_identifier (sym); else { snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name); - return get_identifier (name); + return name; } } else @@ -392,17 +398,40 @@ gfc_sym_mangled_identifier (gfc_symbol * sym) sym->ns->proc_name->module, sym->ns->proc_name->name, sym->name); - return get_identifier (name); + return name; } else { snprintf (name, sizeof name, "__%s_PROC_%s", sym->ns->proc_name->name, sym->name); - return get_identifier (name); + return name; } } } +/* Get mangled identifier, adding the symbol to the global table if + it is not yet already there. */ + +static tree +gfc_sym_mangled_identifier (gfc_symbol * sym) +{ + tree result; + gfc_gsymbol *gsym; + const char *name; + + name = mangled_identifier (sym); + result = get_identifier (name); + + gsym = gfc_find_gsymbol (gfc_gsym_root, name); + if (gsym == NULL) + { + gsym = gfc_get_gsymbol (name, false); + gsym->ns = sym->ns; + gsym->sym_name = sym->name; + } + + return result; +} /* Construct mangled function name from symbol name. */ @@ -1914,6 +1943,22 @@ get_proc_pointer_decl (gfc_symbol *sym) tree decl; tree attributes; + if (sym->module || sym->fn_result_spec) + { + const char *name; + gfc_gsymbol *gsym; + + name = mangled_identifier (sym); + gsym = gfc_find_gsymbol (gfc_gsym_root, name); + if (gsym != NULL) + { + gfc_symbol *s; + gfc_find_symbol (sym->name, gsym->ns, 0, &s); + if (s && s->backend_decl) + return s->backend_decl; + } + } + decl = sym->backend_decl; if (decl) return decl;