[multiple changes]

2019-03-13  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-13 Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/66695
	PR fortran/77746
	PR fortran/79485
	* gfortran.dg/binding_label_tests_30.f90: New test.
	* gfortran.dg/binding_label_tests_31.f90: New test.
	* gfortran.dg/binding_label_tests_32.f90: New test.
	* gfortran.dg/binding_label_tests_33.f90: New test.

From-SVN: r269635

12 files changed, 167 insertions, 17 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index edcacf5..ee39ad8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,27 @@
+2019-03-13  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/87673
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index f6411f1..2f335b2 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -7248,7 +7248,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub,
      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 *binding_label, bool sub,
       && (!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))
 	{
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3e0f634..dd959e6 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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 *);
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 5dcd91a..14cda5f 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6677deb..62c7d37 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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 *where,
 
   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;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 4dfa836..882a4f3 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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_get_gsymbol (const char *name)
   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);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 36b7fdd..ada6370 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -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,9 +2002,22 @@ gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args)
     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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d09651c..c41914e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2019-03-13 Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/66695
+	PR fortran/77746
+	PR fortran/79485
+	* gfortran.dg/binding_label_tests_30.f90: New test.
+	* gfortran.dg/binding_label_tests_31.f90: New test.
+	* gfortran.dg/binding_label_tests_32.f90: New test.
+	* gfortran.dg/binding_label_tests_33.f90: New test.
+
 2019-03-13  Iain Buclaw  <ibuclaw@gdcproject.org>
 
 	* gdc.dg/pr88957.d: Move to gdc.dg/ubsan.
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_30.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_30.f90
new file mode 100644
index 0000000..168d4b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_30.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! Make sure this error is flagged.
+subroutine foo() ! { dg-error "is already being used as a SUBROUTINE" }
+end subroutine foo
+
+subroutine bar() bind(C,name="foo") ! { dg-error "is already being used as a SUBROUTINE" }
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_31.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_31.f90
new file mode 100644
index 0000000..e914c66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_31.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/66695 - this used to ICE.
+! Original test case by Vladimir Fuka.
+module mod
+  implicit none
+contains
+    integer function F()
+    end function
+end module
+    
+module mod_C
+  use mod
+  implicit none
+contains
+  subroutine s()  bind(C, name="f")
+    integer :: x
+      x = F()
+  end subroutine
+end module
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_32.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_32.f90
new file mode 100644
index 0000000..f18df66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_32.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! PR 77746 - this used to crash during execution.
+! Original test case by Vladimir Fuka.
+module first
+  private
+  public execute
+  
+  interface execute
+    module procedure random_name
+  end interface
+  
+contains
+
+  subroutine random_name()
+  end subroutine
+end module
+
+module test
+  use first
+
+  implicit none
+
+contains
+
+  subroutine p_execute(i)  bind(C, name="random_name")
+    integer :: i
+
+    call execute()
+  end subroutine
+  
+end module
+
+  use test
+  call p_execute(1)
+end
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_33.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_33.f90
new file mode 100644
index 0000000..fdb9a88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_33.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! PR 79485 - used to crash because the wrong routine was called.
+module fmod1
+
+  contains
+
+  subroutine foo(i)
+    implicit none
+
+    integer, intent(inout) :: i
+
+    i=i+1
+
+  end subroutine foo
+
+end module fmod1
+
+module fmod2
+  use iso_c_binding
+  use fmod1, only : foo_first => foo
+
+  contains
+
+  subroutine foo(i) bind(c)
+    implicit none
+
+    integer, intent(inout) :: i
+
+    i=i+2
+    call foo_first(i)
+
+  end subroutine foo
+
+end module fmod2
+
+  use fmod2
+  
+  call foo(i)
+end