[RFC gfortran] PR53478 - gfortran segfaults when module name clashes with C binding name of procedure

[RFC gfortran] PR53478 - gfortran segfaults when module name clashes with C binding name of procedure

[Dominique d'Humières]

[-- Attachment #1: Type: text/plain, Size: 1413 bytes --]

This patch implement the requirement

> ... Furthermore, a binding label shall not be
> the same as the global identifier of any other global entity, ignoring
> differences in case."

While looking at the code, I noticed that several %s should be %qs. This is fixed as well by the patch along with the needed adjustment of the test suite.

Tested on darwin.

TIA

Dominique

2017-1-12  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-11-12  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.


[-- Attachment #2: patch-56440 --]
[-- Type: application/octet-stream, Size: 14343 bytes --]

diff -up ../_clean/gcc/fortran/gfortran.h gcc/fortran/gfortran.h
--- ../_clean/gcc/fortran/gfortran.h	2017-10-19 10:07:45.000000000 +0200
+++ gcc/fortran/gfortran.h	2017-10-22 14:11:07.000000000 +0200
@@ -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 -up ../_clean/gcc/fortran/resolve.c gcc/fortran/resolve.c
--- ../_clean/gcc/fortran/resolve.c	2017-10-21 11:31:29.000000000 +0200
+++ gcc/fortran/resolve.c	2017-10-22 14:23:49.000000000 +0200
@@ -1056,7 +1056,7 @@ resolve_common_blocks (gfc_symtree *comm
 			       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);
@@ -11536,7 +11536,7 @@ gfc_verify_binding_labels (gfc_symbol *s
       || 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;
@@ -11572,7 +11572,7 @@ gfc_verify_binding_labels (gfc_symbol *s
 
   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.  */
@@ -11585,8 +11585,8 @@ gfc_verify_binding_labels (gfc_symbol *s
     {
       /* 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;
@@ -11602,7 +11602,7 @@ gfc_verify_binding_labels (gfc_symbol *s
       /* 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 -up ../_clean/gcc/fortran/symbol.c gcc/fortran/symbol.c
--- ../_clean/gcc/fortran/symbol.c	2017-10-21 11:31:29.000000000 +0200
+++ gcc/fortran/symbol.c	2017-10-22 13:20:21.000000000 +0200
@@ -4291,6 +4291,29 @@ gfc_find_gsymbol (gfc_gsymbol *symbol, c
 }
 
 
+/* 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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03	2014-11-15 12:40:18.000000000 +0100
+++ gcc/testsuite/gfortran.dg/binding_label_tests_4.f03	2017-10-21 14:55:24.000000000 +0200
@@ -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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03	2013-05-21 08:15:38.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_6.f03	2017-10-21 15:11:49.000000000 +0200
@@ -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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03	2013-05-21 08:15:39.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_7.f03	2017-10-21 15:13:07.000000000 +0200
@@ -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
 
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03	2013-05-21 08:15:38.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_8.f03	2017-10-21 17:19:29.000000000 +0200
@@ -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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03	2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03	2017-10-21 15:16:20.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03	2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03	2017-10-21 15:17:36.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03	2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03	2017-10-21 15:21:32.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03	2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03	2017-10-22 14:38:27.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90	1970-01-01 01:00:00.000000000 +0100
+++ gcc/testsuite/gfortran.dg/binding_label_tests_29.f90	2017-10-22 16:12:10.000000000 +0200
@@ -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