+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
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*);
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);
|| 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;
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. */
{
/* 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;
/* 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;
}
+/* 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
+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
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" } }
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" } }
! { 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" } }
--- /dev/null
+! { 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
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
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
! { 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
! { 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
! { 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
! { 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" } }