[patch, fortran] Fix PR 90813

[patch, fortran] Fix PR 90813

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 1985 bytes --]

Hello world,

the attached patch fixes PR 90813, a regression with proc pointers.
The problem was quite complex, and I'd like to thank the people
who helped debug this; the most important clue came from Richard.

The problem was that, for a procedure pointer variable declared
in a module in the same file, we were using a different backend
decl in the module than in the main program. This led to the
later parts of the compiler to think that the procedure pointer
was actually two variables which could not alias.  Optimization
on some architectures such as Aarch64 and POWER (but not
on x86_64) then led to reordering of stores, leading to a segfault.

The solution is to put the mangled names into the global
variable table, and to look for it when getting its backend
declaration.

While debugging it, I also put in an option to dump the global
symbol table to standard output.  I have included this in this
patch because I think this may not be the last bug in that
area :-)

Regression-tested on powerpc64le-unknown-linux-gnu, where the
segfault showed up.  No test case because is is already
in the test suite. Doc changes checked with "make dvi" and
"make pdf".

OK for trunk?

Regards

	Thomas
2019-07-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	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.

[-- Attachment #2: p4.diff --]
[-- Type: text/x-patch, Size: 8121 bytes --]

Index: dump-parse-tree.c
===================================================================
--- dump-parse-tree.c	(Revision 273855)
+++ dump-parse-tree.c	(Arbeitskopie)
@@ -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);
+}
Index: gfortran.h
===================================================================
--- gfortran.h	(Revision 273855)
+++ gfortran.h	(Arbeitskopie)
@@ -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);
Index: invoke.texi
===================================================================
--- invoke.texi	(Revision 273855)
+++ invoke.texi	(Arbeitskopie)
@@ -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 gene
 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
Index: lang.opt
===================================================================
--- lang.opt	(Revision 273855)
+++ lang.opt	(Arbeitskopie)
@@ -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.
Index: parse.c
===================================================================
--- parse.c	(Revision 273855)
+++ parse.c	(Arbeitskopie)
@@ -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;
 
Index: symbol.c
===================================================================
--- symbol.c	(Revision 273855)
+++ symbol.c	(Arbeitskopie)
@@ -4357,7 +4357,20 @@ 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)
 {
Index: trans-decl.c
===================================================================
--- trans-decl.c	(Revision 273855)
+++ trans-decl.c	(Arbeitskopie)
@@ -345,39 +345,45 @@ gfc_get_label_decl (gfc_st_label * lp)
     }
 }
 
+/* Return the name of an identifier.  */
 
+static const char *
+sym_identifier (gfc_symbol *sym)
+{
+  if (sym->attr.is_main_program && strcmp (sym->name, "main") == 0)
+    return "MAIN__";
+  else
+    return sym->name;
+}
+
 /* Convert a gfc_symbol to an identifier of the same name.  */
 
 static tree
 gfc_sym_identifier (gfc_symbol * sym)
 {
-  if (sym->attr.is_main_program && strcmp (sym->name, "main") == 0)
-    return (get_identifier ("MAIN__"));
-  else
-    return (get_identifier (sym->name));
+  return get_identifier (sym_identifier (sym));
 }
 
+/* Construct mangled name from symbol name.   */
 
-/* Construct mangled name from symbol name.  */
-
-static tree
-gfc_sym_mangled_identifier (gfc_symbol * sym)
+static const char *
+mangled_identifier (gfc_symbol *sym)
 {
-  char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
-
+  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,18 +398,41 @@ gfc_sym_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.  */
 
 static tree
@@ -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;

Re: [patch, fortran] Fix PR 90813

[Steve Kargl]

On Sun, Jul 28, 2019 at 11:50:03PM +0200, Thomas Koenig wrote:
> Index: parse.c
> ===================================================================
> --- parse.c	(Revision 273855)
> +++ parse.c	(Arbeitskopie)
> @@ -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

s/ist/list

> +     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;

Other than the typo above, the patch looks good to me.
You may want to give others a day or 2 to review the
patch.

-- 
Steve

Re: [patch, fortran] Fix PR 90813

[Paul Richard Thomas]

Hi Thomas,

That is very well done. Thanks for picking it up and running with it.
OK on both the fix and the dumping of the gsymbols.

You might consider back porting both this patch and my fix for the
original bug to 9-branch.

Regards

Paul

On Sun, 28 Jul 2019 at 22:50, Thomas Koenig <tkoenig@netcologne.de> wrote:
>
> Hello world,
>
> the attached patch fixes PR 90813, a regression with proc pointers.
> The problem was quite complex, and I'd like to thank the people
> who helped debug this; the most important clue came from Richard.
>
> The problem was that, for a procedure pointer variable declared
> in a module in the same file, we were using a different backend
> decl in the module than in the main program. This led to the
> later parts of the compiler to think that the procedure pointer
> was actually two variables which could not alias.  Optimization
> on some architectures such as Aarch64 and POWER (but not
> on x86_64) then led to reordering of stores, leading to a segfault.
>
> The solution is to put the mangled names into the global
> variable table, and to look for it when getting its backend
> declaration.
>
> While debugging it, I also put in an option to dump the global
> symbol table to standard output.  I have included this in this
> patch because I think this may not be the last bug in that
> area :-)
>
> Regression-tested on powerpc64le-unknown-linux-gnu, where the
> segfault showed up.  No test case because is is already
> in the test suite. Doc changes checked with "make dvi" and
> "make pdf".
>
> OK for trunk?
>
> Regards
>
>         Thomas
> 2019-07-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
>
>         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.



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: [patch, fortran] Fix PR 90813

[Thomas Koenig]

Hi Paul,

> That is very well done. Thanks for picking it up and running with it.
> OK on both the fix and the dumping of the gsymbols.

Committed, thanks.

> You might consider back porting both this patch and my fix for the
> original bug to 9-branch.

Both patches apply cleanly together on gcc-9 (well, except for the
whitespace fix of a comment that didn't exist yet in gcc-9, so
I think we can ignore than), and pass regression-tests on POWER9.

So, I will commit this tonight.

Regards

	Thomas