re PR fortran/53478 (gfortran segfaults when module name clashes with C binding name...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c98c64b7059b4b2c0b3e65080b88de270250d025..a668e12eb3e8a59cb76166a3acdd43b5da1e8b34 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 97db5b054e4cc705469e2b6fd11ea3e8b004820a..c5e62d7200a3b64b66a9d94984b258cb235dc417 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/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*);

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 041ee0d6459854b562b045f68c0b6a60b6dfea9e..f819b7158612979db6cf6c733d8174868d47a3bd 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 11b6f600103ab5a39ffb3b9174e816f8bb3ed312..dc1688aa2d7e6590aad49206d85ff6b4763e04c9 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fcd31bb12a1820630086876f47e00dd5eae778a9..dbffa8214c76888137077689a1fe42c2c4626d2c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,16 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03
index bce5ef68c4272278c512b8bfae5668f884f736a5..fc961a4f3bf92db9b01b5d8eed21b4f370b9ad81 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03
+++ b/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" } }

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03
index 7ee0c8de473c4bb42c7759209f4a118f9994cf15..c7a75b5cbf9dd7e7f509679a099a8498f1dd5e2c 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03
+++ b/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" } }

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03
index 66ff7cf33cf6bab0d9150bbcedd7ea820b84d9f9..55743b79b202abb035e6de9135333eb1515776f5 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03
+++ b/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" } }

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90
new file mode 100644 (file)
index 0000000..d4b6cfb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90
@@ -0,0 +1,13 @@
+! { 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

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03
index 69db9756f6e2a02d424e97744400e780526c6782..7214289c976847ed6f8b3fa46dbe78819b9b7483 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
index d213819f20b38284aec59d9985477ef6ae945d5a..52be7f15f2bb799a005c4b080d77873ff46fed99 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
@@ -1,6 +1,6 @@
 ! { 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

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
index 1e261a995b87cb71c1f6ed047ad9d65e1fcc664d..6811ceac54f377d3be7a8bef5426f32c0671f339 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
@@ -1,13 +1,13 @@
 ! { 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
 

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
index 2f507b9e2334918ad07b39a93a45726dc48660b6..be5d004204c178c17b7456de10dabeb29391dae9 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
@@ -1,9 +1,9 @@
 ! { 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

diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03
index 9ad55156e8349b61d5c60ce099e78dfd168249d8..4ee6cefd996ceb704df7c63665ef3fdc3098b7bf 100644 (file)
--- a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03
+++ b/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" } }