[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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index edcacf5023142139985c81e5d9cc464539a3ae2a..ee39ad8d398bef9fd6779d4515055a935c277a63 100644 (file)
--- 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 f6411f148752f2dfeb8894aa46d1998ff14dac27..2f335b24835896b9523d4e515ee854dbb95961de 100644 (file)
--- 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 3e0f634c3a8e3992f13054b0df26ba1d698e7c50..dd959e6403ecaf2e76554bec104077a519794441 100644 (file)
--- 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 5dcd91af6cf18f21eb24af51c01f715766b80afe..14cda5f9fba42e606eddf9654daf7daed682a272 100644 (file)
--- 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 6677deb3bdcafa435ae1dcba33fa44aa2cb341ea..62c7d376b92182b67341bf5683285dfc28ec078e 100644 (file)
--- 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 4dfa836dddf43b9b5ec46f74185a3d86d9b6a450..882a4f323f814e4040cc9dc611ac8e72027675fc 100644 (file)
--- 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 36b7fdd2701f2ed2c6ee8eabe818214caf104943..ada6370899ac62ed9565f21557249bcdcd21f9ea 100644 (file)
--- 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 d09651c5a97a65d724b57dac4e74eab1b613286a..c41914e6f389e01104762b7bde1a82c8e1bc13da 100644 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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