re PR fortran/53478 (gfortran segfaults when module name clashes with C binding name of procedure)

2017-12-10  Dominique d'Humieres  <dominiq@lps.ens.fr>

	PR fortran/53478
	* gfortran.h (gfc_find_case_gsymbol): New prototype.
	* symbol.c (gfc_find_case_gsymbol): New procedure, case
	insensistive version of gfc_find_gsymbol.
	* resolve.c (resolve_common_blocks): Use it.
	Replace %s with %qs where needed.

	* gfortran.dg/binding_label_tests_4.f03: Update dg-error.
	* gfortran.dg/binding_label_tests_6.f03: Likewise.
	* gfortran.dg/binding_label_tests_7.f03: Likewise.
	* gfortran.dg/binding_label_tests_8.f03: Likewise.
	* gfortran.dg/binding_label_tests_10_main.f03: Likewise.
	* gfortran.dg/binding_label_tests_11_main.f03: Likewise.
	* gfortran.dg/binding_label_tests_13_main.f03: Likewise.
	* gfortran.dg/test_common_binding_labels_3_main.f03: Likewise.
	* gfortran.dg/binding_label_tests_29.f90: New test.

From-SVN: r255530

gcc/fortran/ChangeLog

+2017-12-10  Dominique d'Humieres  <dominiq@lps.ens.fr>
+
+	PR fortran/53478
+	* gfortran.h (gfc_find_case_gsymbol): New prototype.
+	* symbol.c (gfc_find_case_gsymbol): New procedure, case
+	insensistive version of gfc_find_gsymbol.
+	* resolve.c (resolve_common_blocks): Use it.
+	Replace %s with %qs where needed.
+
 2017-12-09  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/82934

gcc/fortran/gfortran.h

@@ -3035,6 +3035,7 @@ void gfc_free_dt_list (void);
 
 gfc_gsymbol *gfc_get_gsymbol (const char *);
 gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
+gfc_gsymbol *gfc_find_case_gsymbol (gfc_gsymbol *, const char *);
 
 gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
 gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);

gcc/fortran/resolve.c

@@ -1056,7 +1056,7 @@ resolve_common_blocks (gfc_symtree *common_root)
 			       common_root->n.common->binding_label);
       if (gsym && gsym->type != GSYM_COMMON)
 	{
-	  gfc_error ("COMMON block at %L with binding label %s uses the same "
+	  gfc_error ("COMMON block at %L with binding label %qs uses the same "
 		     "global identifier as entity at %L",
 		     &common_root->n.common->where,
 		     common_root->n.common->binding_label, &gsym->where);
@@ -11542,7 +11542,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
       || sym->attr.flavor == FL_DERIVED || !sym->binding_label)
     return;
 
-  gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label);
+  gsym = gfc_find_case_gsymbol (gfc_gsym_root, sym->binding_label);
 
   if (sym->module)
     module = sym->module;
@@ -11578,7 +11578,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
 
   if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN)
     {
-      gfc_error ("Variable %s with binding label %s at %L uses the same global "
+      gfc_error ("Variable %qs with binding label %qs at %L uses the same global "
 		 "identifier as entity at %L", sym->name,
 		 sym->binding_label, &sym->declared_at, &gsym->where);
       /* Clear the binding label to prevent checking multiple times.  */
@@ -11591,8 +11591,8 @@ gfc_verify_binding_labels (gfc_symbol *sym)
     {
       /* This can only happen if the variable is defined in a module - if it
 	 isn't the same module, reject it.  */
-      gfc_error ("Variable %s from module %s with binding label %s at %L uses "
-		   "the same global identifier as entity at %L from module %s",
+      gfc_error ("Variable %qs from module %qs with binding label %qs at %L "
+		 "uses the same global identifier as entity at %L from module %qs",
 		 sym->name, module, sym->binding_label,
 		 &sym->declared_at, &gsym->where, gsym->mod_name);
       sym->binding_label = NULL;
@@ -11608,7 +11608,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
       /* Print an error if the procedure is defined multiple times; we have to
 	 exclude references to the same procedure via module association or
 	 multiple checks for the same procedure.  */
-      gfc_error ("Procedure %s with binding label %s at %L uses the same "
+      gfc_error ("Procedure %qs with binding label %qs at %L uses the same "
 		 "global identifier as entity at %L", sym->name,
 		 sym->binding_label, &sym->declared_at, &gsym->where);
       sym->binding_label = NULL;

gcc/fortran/symbol.c

@@ -4291,6 +4291,29 @@ gfc_find_gsymbol (gfc_gsymbol *symbol, const char *name)
 }
 
 
+/* Case insensitive search a tree for the global symbol.  */
+
+gfc_gsymbol *
+gfc_find_case_gsymbol (gfc_gsymbol *symbol, const char *name)
+{
+  int c;
+
+  if (symbol == NULL)
+    return NULL;
+
+  while (symbol)
+    {
+      c = strcasecmp (name, symbol->name);
+      if (!c)
+	return symbol;
+
+      symbol = (c < 0) ? symbol->left : symbol->right;
+    }
+
+  return NULL;
+}
+
+
 /* Compare two global symbols. Used for managing the BB tree.  */
 
 static int

gcc/testsuite/ChangeLog

+2017-12-10  Dominique d'Humieres  <dominiq@lps.ens.fr>
+
+	PR fortran/53478
+	* gfortran.dg/binding_label_tests_4.f03: Update dg-error.
+	* gfortran.dg/binding_label_tests_6.f03: Likewise.
+	* gfortran.dg/binding_label_tests_7.f03: Likewise.
+	* gfortran.dg/binding_label_tests_8.f03: Likewise.
+	* gfortran.dg/binding_label_tests_10_main.f03: Likewise.
+	* gfortran.dg/binding_label_tests_11_main.f03: Likewise.
+	* gfortran.dg/binding_label_tests_13_main.f03: Likewise.
+	* gfortran.dg/test_common_binding_labels_3_main.f03: Likewise.
+	* gfortran.dg/binding_label_tests_29.f90: New test.
+
 2017-12-10  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/83337

gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03

@@ -3,11 +3,10 @@
 module binding_label_tests_10_main
   use iso_c_binding
   implicit none
-  integer(c_int), bind(c,name="c_one") :: one ! { dg-error "Variable one from module binding_label_tests_10 with binding label c_one at .1. uses the same global identifier as entity at .2. from module binding_label_tests_10_main" }
+  integer(c_int), bind(c,name="c_one") :: one ! { dg-error "Variable 'one' from module 'binding_label_tests_10' with binding label 'c_one' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_10_main'" }
 end module binding_label_tests_10_main
 
 program main
-  use binding_label_tests_10 ! { dg-error "Variable one from module binding_label_tests_10 with binding label c_one at .1. uses the same global identifier as entity at .2. from module binding_label_tests_10_main" }
+  use binding_label_tests_10 ! { dg-error "Variable 'one' from module 'binding_label_tests_10' with binding label 'c_one' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_10_main'" }
   use binding_label_tests_10_main
 end program main
-! { dg-final { cleanup-modules "binding_label_tests_10" } }

gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03

@@ -4,14 +4,13 @@ module binding_label_tests_11_main
   use iso_c_binding, only: c_int
   implicit none
 contains
-  function one() bind(c, name="c_one") ! { dg-error "Procedure one with binding label c_one at .1. uses the same global identifier as entity at .2." }
+  function one() bind(c, name="c_one") ! { dg-error "Procedure 'one' with binding label 'c_one' at .1. uses the same global identifier as entity at .2." }
     integer(c_int) one
     one = 1
   end function one
 end module binding_label_tests_11_main
 
 program main
-  use binding_label_tests_11 ! { dg-error "Procedure one with binding label c_one at .1. uses the same global identifier as entity at .2." }
+  use binding_label_tests_11 ! { dg-error "Procedure 'one' with binding label 'c_one' at .1. uses the same global identifier as entity at .2." }
   use binding_label_tests_11_main
 end program main
-! { dg-final { cleanup-modules "binding_label_tests_11" } }

gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03

@@ -2,12 +2,11 @@
 ! { dg-compile-aux-modules "binding_label_tests_13.f03" }
 module binding_label_tests_13_main
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int) :: c3  ! { dg-error "Variable c3 from module binding_label_tests_13_main with binding label c3 at .1. uses the same global identifier as entity at .2. from module binding_label_tests_13" }
+  integer(c_int) :: c3  ! { dg-error "Variable 'c3' from module 'binding_label_tests_13_main' with binding label 'c3' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_13'" }
   bind(c) c3
 
 contains
   subroutine c_sub() BIND(c, name = "C_Sub")
-    use binding_label_tests_13 ! { dg-error "Variable c3 from module binding_label_tests_13_main with binding label c3 at .1. uses the same global identifier as entity at .2. from module binding_label_tests_13" }
+    use binding_label_tests_13 ! { dg-error "Variable 'c3' from module 'binding_label_tests_13_main' with binding label 'c3' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_13'" }
   end subroutine c_sub
 end module binding_label_tests_13_main
-! { dg-final { cleanup-modules "binding_label_tests_13" } }

gcc/testsuite/gfortran.dg/binding_label_tests_29.f90

+! { dg-do compile }
+! PR53478
+
+module test_bug ! { dg-error "Procedure 'test' with binding label 'Test_Bug' at .1. uses the same global identifier as entity at .2." }
+
+use, intrinsic :: ISO_C_BINDING
+
+contains
+
+  subroutine test() bind (C, name = "Test_Bug") ! { dg-error "Procedure 'test' with binding label 'Test_Bug' at .1. uses the same global identifier as entity at .2." }
+  end subroutine
+
+end module

gcc/testsuite/gfortran.dg/binding_label_tests_4.f03

@@ -2,7 +2,7 @@
 module A
   use, intrinsic :: iso_c_binding
 contains
-  subroutine pA() bind(c, name='printf') ! { dg-error "Procedure pb with binding label printf at .1. uses the same global identifier as entity at .2." }
+  subroutine pA() bind(c, name='printf') ! { dg-error "Procedure 'pb' with binding label 'printf' at .1. uses the same global identifier as entity at .2." }
     print *, 'hello from pA'
   end subroutine pA
 end module A
@@ -11,7 +11,7 @@ module B
   use, intrinsic :: iso_c_binding
 
 contains
-  subroutine pB() bind(c, name='printf') ! { dg-error "Procedure pb with binding label printf at .1. uses the same global identifier as entity at .2." }
+  subroutine pB() bind(c, name='printf') ! { dg-error "Procedure 'pb' with binding label 'printf' at .1. uses the same global identifier as entity at .2." }
     print *, 'hello from pB'
   end subroutine pB
 end module B

gcc/testsuite/gfortran.dg/binding_label_tests_6.f03

 ! { dg-do compile }
 module binding_label_tests_6
   use, intrinsic :: iso_c_binding
-  integer(c_int), bind(c, name='my_int') :: my_f90_int_1 ! { dg-error "Variable my_f90_int_2 from module binding_label_tests_6 with binding label my_int at .1. uses the same global identifier as entity at .2. from module binding_label_tests_6" }
-  integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "Variable my_f90_int_2 from module binding_label_tests_6 with binding label my_int at .1. uses the same global identifier as entity at .2. from module binding_label_tests_6" }
+  integer(c_int), bind(c, name='my_int') :: my_f90_int_1 ! { dg-error "Variable 'my_f90_int_2' from module 'binding_label_tests_6' with binding label 'my_int' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_6'" }
+  integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "Variable 'my_f90_int_2' from module 'binding_label_tests_6' with binding label 'my_int' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_6'" }
 end module binding_label_tests_6

gcc/testsuite/gfortran.dg/binding_label_tests_7.f03

 ! { dg-do compile }
 module A
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int), bind(c, name='my_c_print') :: my_int ! { dg-error "Procedure my_c_print with binding label my_c_print at .1. uses the same global identifier as entity at .2." }
+  integer(c_int), bind(c, name='my_c_print') :: my_int ! { dg-error "Procedure 'my_c_print' with binding label 'my_c_print' at .1. uses the same global identifier as entity at .2." }
 end module A
 
 program main
 use A
 interface
-   subroutine my_c_print() bind(c) ! { dg-error "Procedure my_c_print with binding label my_c_print at .1. uses the same global identifier as entity at .2." }
+   subroutine my_c_print() bind(c) ! { dg-error "Procedure 'my_c_print' with binding label 'my_c_print' at .1. uses the same global identifier as entity at .2." }
    end subroutine my_c_print
 end interface
 

gcc/testsuite/gfortran.dg/binding_label_tests_8.f03

 ! { dg-do compile }
 module binding_label_tests_8
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int), bind(c, name='my_f90_sub') :: my_c_int  ! { dg-error "Variable my_c_int with binding label my_f90_sub at .1. uses the same global identifier as entity at .2." }
+  integer(c_int), bind(c, name='my_f90_sub') :: my_c_int  ! { dg-error "Variable 'my_c_int' with binding label 'my_f90_sub' at .1. uses the same global identifier as entity at .2." }
 
 contains
-  subroutine my_f90_sub() bind(c) ! { dg-error "Variable my_c_int with binding label my_f90_sub at .1. uses the same global identifier as entity at .2." }
+  subroutine my_f90_sub() bind(c) ! { dg-error "Variable 'my_c_int' with binding label 'my_f90_sub' at .1. uses the same global identifier as entity at .2." }
   end subroutine my_f90_sub
 end module binding_label_tests_8

gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03

@@ -2,11 +2,10 @@
 ! { dg-compile-aux-modules "test_common_binding_labels_3.f03" }
 module test_common_binding_labels_3_main
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int), bind(c, name="my_common_block") :: my_int ! { dg-error "COMMON block at .1. with binding label my_common_block uses the same global identifier as entity at .2." }
+  integer(c_int), bind(c, name="my_common_block") :: my_int ! { dg-error "COMMON block at .1. with binding label 'my_common_block' uses the same global identifier as entity at .2." }
 end module test_common_binding_labels_3_main
 
 program main
   use test_common_binding_labels_3_main
-  use test_common_binding_labels_3 ! { dg-error "COMMON block at .1. with binding label my_common_block uses the same global identifier as entity at .2." }
+  use test_common_binding_labels_3 ! { dg-error "COMMON block at .1. with binding label 'my_common_block' uses the same global identifier as entity at .2." }
 end program main
-! { dg-final { cleanup-modules "test_common_binding_labels_3" } }