diff mbox series

[fortran] Fix PR 66695, 77746 and 79485

Message ID 5b16d6f2-1bc0-f959-6e55-3589112102e6@netcologne.de
State New
Headers show
Series [fortran] Fix PR 66695, 77746 and 79485 | expand

Commit Message

Thomas Koenig March 12, 2019, 9:42 p.m. UTC 
Hello world,

the attached patch fixes three very closely related 7/8/9 regressions.
The common root cause of these PRs was that , if a binding label
existed, gfc_get_extern_function_decl first looked for that name
in the global symbol table for that function and used its backend_decl.
If there was a module procedure with the same name as the BIND(C)
routine (perfectly legal), the wrong procedure would then be called.

The approach is straightforward: In the global symbol table, record
whether we are looking at a "normal" or a BIND(C) name, and if we
come across the wrong kind of entry in gfc_get_extern_function_decl,
just ignore it.

Regressoin-tested. OK for trunk?

Regards

	Thomas

2019-03-12  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/66695
	PR fortran/77746
	PR fortran/79485
	* gfortran.h (gfc_symbol): Add bind_c component.
	(gfc_get_gsymbol): Add argument bind_c.
	* decl.c (add_global_entry): Add bind_c argument to
	gfc_get_symbol.
	* parse.c (parse_block_data): Likewise.
	(parse_module): Likewise.
	(add_global_procedure): Likewise.
	(add_global_program): Likewise.
	* resolve.c (resolve_common_blocks): Likewise.
	(resolve_global_procedure): Likewise.
	(gfc_verify_binding_labels): Likewise.
	* symbol.c (gfc_get_gsymbol): Add argument bind_c. Set bind_c
	in gsym.
	* trans-decl.c (gfc_get_module_backend_decl): Add bind_c argument
	to gfc_get_symbol.
	(gfc_get_extern_function_decl): If the sym has a binding label
	and it cannot be found in the global symbol tabel, it is the wrong
	one and vice versa.

2019-03-12  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/66695
	PR fortran/77746
	PR fortran/79485
	* gfortran.dg/binding_label_tests_24.f90: New test.
	* gfortran.dg/binding_label_tests_25.f90: New test.
	* gfortran.dg/binding_label_tests_26.f90: New test.
	* gfortran.dg/binding_label_tests_27.f90: New test.

Comments

Steve Kargl March 13, 2019, 12:39 a.m. UTC | #1 
On Tue, Mar 12, 2019 at 10:42:21PM +0100, Thomas Koenig wrote:
> 
> the attached patch fixes three very closely related 7/8/9 regressions.
> The common root cause of these PRs was that , if a binding label
> existed, gfc_get_extern_function_decl first looked for that name
> in the global symbol table for that function and used its backend_decl.
> If there was a module procedure with the same name as the BIND(C)
> routine (perfectly legal), the wrong procedure would then be called.
> 
> The approach is straightforward: In the global symbol table, record
> whether we are looking at a "normal" or a BIND(C) name, and if we
> come across the wrong kind of entry in gfc_get_extern_function_decl,
> just ignore it.
> 
> Regressoin-tested. OK for trunk?

Looks good to me.
Thomas Koenig March 13, 2019, 7:23 a.m. UTC | #2 
Hi Steve,

>> Regressoin-tested. OK for trunk?
> Looks good to me.

Committed as r269635, with one correction: When checking with SVN, I
found that I had misnumbered the test cases - I have now committed
them as binding_label_tests_30.f90 to binding_label_tests_33.f90.

Thanks for the review!

Regards

	Thomas
diff mbox series

Patch

Index: gfortran.h
===================================================================
--- gfortran.h	(Revision 269624)
+++ gfortran.h	(Arbeitskopie)
@@ -1891,6 +1891,7 @@  typedef struct gfc_gsymbol
   enum gfc_symbol_type type;
 
   int defined, used;
+  bool bind_c;
   locus where;
   gfc_namespace *ns;
 }
@@ -3114,7 +3115,7 @@  void gfc_enforce_clean_symbol_state (void);
 void gfc_free_dt_list (void);
 
 
-gfc_gsymbol *gfc_get_gsymbol (const char *);
+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 *);
 
Index: decl.c
===================================================================
--- decl.c	(Revision 269624)
+++ decl.c	(Arbeitskopie)
@@ -7248,7 +7248,7 @@  add_global_entry (const char *name, const char *bi
      name is a global identifier.  */
   if (!binding_label || gfc_notification_std (GFC_STD_F2008))
     {
-      s = gfc_get_gsymbol (name);
+      s = gfc_get_gsymbol (name, false);
 
       if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type))
 	{
@@ -7270,7 +7270,7 @@  add_global_entry (const char *name, const char *bi
       && (!gfc_notification_std (GFC_STD_F2008)
 	  || strcmp (name, binding_label) != 0))
     {
-      s = gfc_get_gsymbol (binding_label);
+      s = gfc_get_gsymbol (binding_label, true);
 
       if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type))
 	{
Index: parse.c
===================================================================
--- parse.c	(Revision 269624)
+++ parse.c	(Arbeitskopie)
@@ -5839,7 +5839,7 @@  parse_block_data (void)
     }
   else
     {
-      s = gfc_get_gsymbol (gfc_new_block->name);
+      s = gfc_get_gsymbol (gfc_new_block->name, false);
       if (s->defined
 	  || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA))
        gfc_global_used (s, &gfc_new_block->declared_at);
@@ -5921,7 +5921,7 @@  parse_module (void)
   gfc_gsymbol *s;
   bool error;
 
-  s = gfc_get_gsymbol (gfc_new_block->name);
+  s = gfc_get_gsymbol (gfc_new_block->name, false);
   if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE))
     gfc_global_used (s, &gfc_new_block->declared_at);
   else
@@ -5985,7 +5985,7 @@  add_global_procedure (bool sub)
      name is a global identifier.  */
   if (!gfc_new_block->binding_label || gfc_notification_std (GFC_STD_F2008))
     {
-      s = gfc_get_gsymbol (gfc_new_block->name);
+      s = gfc_get_gsymbol (gfc_new_block->name, false);
 
       if (s->defined
 	  || (s->type != GSYM_UNKNOWN
@@ -6010,7 +6010,7 @@  add_global_procedure (bool sub)
       && (!gfc_notification_std (GFC_STD_F2008)
           || strcmp (gfc_new_block->name, gfc_new_block->binding_label) != 0))
     {
-      s = gfc_get_gsymbol (gfc_new_block->binding_label);
+      s = gfc_get_gsymbol (gfc_new_block->binding_label, true);
 
       if (s->defined
 	  || (s->type != GSYM_UNKNOWN
@@ -6042,7 +6042,7 @@  add_global_program (void)
 
   if (gfc_new_block == NULL)
     return;
-  s = gfc_get_gsymbol (gfc_new_block->name);
+  s = gfc_get_gsymbol (gfc_new_block->name, false);
 
   if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM))
     gfc_global_used (s, &gfc_new_block->declared_at);
Index: resolve.c
===================================================================
--- resolve.c	(Revision 269624)
+++ resolve.c	(Arbeitskopie)
@@ -1050,7 +1050,7 @@  resolve_common_blocks (gfc_symtree *common_root)
 	}
       if (!gsym)
 	{
-	  gsym = gfc_get_gsymbol (common_root->n.common->name);
+	  gsym = gfc_get_gsymbol (common_root->n.common->name, false);
 	  gsym->type = GSYM_COMMON;
 	  gsym->where = common_root->n.common->where;
 	  gsym->defined = 1;
@@ -1072,7 +1072,7 @@  resolve_common_blocks (gfc_symtree *common_root)
 	}
       if (!gsym)
 	{
-	  gsym = gfc_get_gsymbol (common_root->n.common->binding_label);
+	  gsym = gfc_get_gsymbol (common_root->n.common->binding_label, true);
 	  gsym->type = GSYM_COMMON;
 	  gsym->where = common_root->n.common->where;
 	  gsym->defined = 1;
@@ -2487,7 +2487,8 @@  resolve_global_procedure (gfc_symbol *sym, locus *
 
   type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
 
-  gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name);
+  gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name,
+			  sym->binding_label != NULL);
 
   if ((gsym->type != GSYM_UNKNOWN && gsym->type != type))
     gfc_global_used (gsym, where);
@@ -11847,7 +11848,7 @@  gfc_verify_binding_labels (gfc_symbol *sym)
 	  && (gsym->type == GSYM_FUNCTION || gsym->type == GSYM_SUBROUTINE)))
     {
       if (!gsym)
-	gsym = gfc_get_gsymbol (sym->binding_label);
+	gsym = gfc_get_gsymbol (sym->binding_label, true);
       gsym->where = sym->declared_at;
       gsym->sym_name = sym->name;
       gsym->binding_label = sym->binding_label;
Index: symbol.c
===================================================================
--- symbol.c	(Revision 269624)
+++ symbol.c	(Arbeitskopie)
@@ -4330,7 +4330,7 @@  gsym_compare (void *_s1, void *_s2)
 /* Get a global symbol, creating it if it doesn't exist.  */
 
 gfc_gsymbol *
-gfc_get_gsymbol (const char *name)
+gfc_get_gsymbol (const char *name, bool bind_c)
 {
   gfc_gsymbol *s;
 
@@ -4341,6 +4341,7 @@  gfc_gsymbol *
   s = XCNEW (gfc_gsymbol);
   s->type = GSYM_UNKNOWN;
   s->name = gfc_get_string ("%s", name);
+  s->bind_c = bind_c;
 
   gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare);
 
Index: trans-decl.c
===================================================================
--- trans-decl.c	(Revision 269624)
+++ trans-decl.c	(Arbeitskopie)
@@ -843,7 +843,7 @@  gfc_get_module_backend_decl (gfc_symbol *sym)
 	{
 	  if (!gsym)
 	    {
-	      gsym = gfc_get_gsymbol (sym->module);
+	      gsym = gfc_get_gsymbol (sym->module, false);
 	      gsym->type = GSYM_MODULE;
 	      gsym->ns = gfc_get_namespace (NULL, 0);
 	    }
@@ -2002,10 +2002,23 @@  gfc_get_extern_function_decl (gfc_symbol * sym, gf
     return get_proc_pointer_decl (sym);
 
   /* See if this is an external procedure from the same file.  If so,
-     return the backend_decl.  */
-  gsym =  gfc_find_gsymbol (gfc_gsym_root, sym->binding_label
-					   ? sym->binding_label : sym->name);
+     return the backend_decl.  If we are looking at a BIND(C)
+     procedure and the symbol is not BIND(C), or vice versa, we
+     haven't found the right procedure.  */
 
+  if (sym->binding_label)
+    {
+      gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label);
+      if (gsym && !gsym->bind_c)
+	gsym = NULL;
+    }
+  else
+    {
+      gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name);
+      if (gsym && gsym->bind_c)
+	gsym = NULL;
+    }
+
   if (gsym && !gsym->defined)
     gsym = NULL;